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MODULE BASSMAT_IO ( ‘Basic Matrix 1/0 element transmitter - UPI Level 
IDENT = "1-016" i File: BASMATIO.B } Edit: 0G1016 et 


BEGIN 


ORESESISTICTICT OSTEO ESET CCE TCT e icc cece icici iii tii iit iiie | 
‘ 


:* COPYRIGHT (c) 1978, 1980, 1982, 1984 BY 
i® DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASSACHUSETTS. 
'@ ALL RIGHTS RESERVED. 


'® rs SOF TWARE is Cyne) eo UNDER A LICENSE AND MAY BE USED AND COPIED 
:* ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE 
ie INCLUSION OF THE "ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER 

!* COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY 
:* OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY 
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:* THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE 
:; ompokat itn. NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT 


is DIGITAL ASSUMES NO RESPONSIBI 
ie SOFTWARE ON EQUIPMENT WHICH | 
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LITY FOR THE USE OR RELIABILITY OF ITS 
S NOT SUPPLIED BY DIGITAL. 
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+ 
FACILITY: VAX-11 BASIC Language support 
ABSTRACT: 


This module contains the UPI Level element transmitters for Matrix 1/0. 
For matrix 1/0, an element is an entire array. The UPI then marches 
through the Coser rorer and calls the PRINT or INPUT UDF for each element 
in the array. MAT I/0 gets its own UPI module so that MAT 1/0 can be 
excluded from the sharable Library. 


ENVIRONMENT: User access mode, AST reentrant. 
AUTHOR: Donald G. Petersen, CREATION DATE: 01-Sep-79 
MODIFIED BY: 


DGP, 0i- 5 id Vv aston 
- origi na DGP p-7 

- Remove ek ah to POT eSSA CUR UB so oothis module need not be 

in the sharable brary. Jes T ép P=1 

Finish development for FT2 “75 79 

More work on MAT Poa snet DGP - a Pa 

= Work on MAT ‘9 for strin s. DGP 1 ct-79 
MAT sd initial zing neorrectly, DGP 15-Oct-79 

~ ~~ ’ mi ‘ READ. and LINPUT fot initializing UPPER_BOUND1 properly. 

1-008 - Bug fix in 2 dimensional MAT PRINT with both optional args. DGP 
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14-Nov-79 

Deallocate any son orary storage allocated. DGP 14-Nov-79 

a & he built Sant t UNT declaration inside the routines that 
t. 0-Aug-1 


Add cunserk "1s byte, 3 & h floating. PUL 22-Sep-81 
Add support for decimal arrays, and dynamically Dapped arrays. PLL 23-Mar-1982 
Fix bug in MAT PRINT of strings. Null strings caused an error. 


1-014 - PLL Bape L : yeres in the calls to the g and h store routines. 
1-015 = TEMP_STORE in_IN_MAT should be 4 longwords. PLL 8-Apr-198 
1-016 = TEMP-STORE (03 should be cleared out before FETCH 09 "donee cally 
mapped byte or word array elements. DG 13-Jan-1984 
'<BLF /PAGE> 
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nt O8) 
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3 4 08 

; 8 B08? 
: 8 O16 
; 591 
5 0236 
3 059 

3 0594 
3 595 
; 596 
3 0597 
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3 0599 
3 0600 
: 0602 
: 0608 
3 1 0604 
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3 4 060 
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; 0 
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SWITCHES 


LINKAGES 


REQUIRE *RTLIN:BASLNK'; 
REQUIRE "RTILIN:OTSLNK'; 


TABLE OF CONTENTS: 


FORWARD ROUTINE 
BASS$N 


S$NUM 
BASSNUM 
BASSSNUM2_INIT : NOVALUE, 
BASSSNUM_INIT : NOVALUE, 
$OUT_MAT_S : NOVALUE, 
BASSOUT"MAT_C : NOVALUE, 
BASSOUT-MAT-B : NOVALUE, 


BASSIN_MAT 7 NOVALUE; 
] 


INCLUDE FILES: 


REQUIRE ‘RTLML:BASPAR’; 
REQUIRE *RTLIN:RTLPSECT'; 
REQUIRE "RTLML:OTSISB’; 
REQUIRE "RTLML:OTSLUB’; 
LIBRARY ‘RTLSTARLE'; 


MACROS: 


4 
Sep-19be 11:55:19 


- 


AX-11 Bliss- 


SWITCHES ADDRESSING _MODE (EXTERNAL = GENERAL, NONEXTERNAL = WORD_RELATIVE); 


Some Basic specific Linkages 
ALL of the rest of the Linkages 


Returns the value of NUM 
returns the value of NUM2 
initialize NUM2 

initialize NUM 

Matrix PRINT, semicolon format 
Matrix PRINT, comma format 
Matrix PRINT, no format 

Matrix INPUT 


some Basic constants 

Psect definitions 

1/0 statement block (ISB) offsets 
Logical Unit Block (LUB) offsets 
System macros and symbols 


upper bound, one dimensional array 
first upper bound, two dim. array 
second upper bound, two dim. array 


l § 32 v4.0 
BASRTL.SRC JBASMATIO 


SMAT_10 16-5 sep: 1384 90: $3: 46 AX-11 biogas KF 10 685.1 


16 -$ BASRT i° BASMATIO.83 
¢ DECLARE PSECTS (BAS); ! Basic psects 
4 | EQUATED SYMBOLS: 
NONE 
; OWN STORAGE: 
OWN 
NUM : INITIAL (0) ' Number of columns entered 
NUM2 : INITIAL (05; ! Number of rows entered for 2 dim. array else 0 


EXTERNAL REFERENCES: 

EXTERNAL ROUTINE 
STRSFREE1_DX, 
rit og LINE  attce CCB NOVALUE, 


1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
4 
1 
1 
1 
1 
' 
' Free a Gyoonic at yer tng 
1 

! BASSSUDF WL 
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1 
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1 

1 
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1 
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1 
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write a blank 
UDF Level - Bi list directed 
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8 

9 

0 

4 

‘ 

8 

9 

0 ' 

1 ; 

¢ ef CCB, ; 

1 : CALL-CCB NOVALUE, ! UDF Level - write List directed 

4 BASSFETCA_BFA : NOVALUE, ! Call = fetch from an array 
5 BASSSTORE_BFA : NOVALUE, ! Call = store into an rey 
6 BASSSSTOP : NOVALU ! signal an error and s 

7 BAS$$CB_GET : JSB_ “C6. GET NOVALUE, i Load CUR_LUB into register CCB 
8 BASSFETFAB_RB VA_JSB, ! fetch from byte array 

9 BASSFET_FA_W_R8& : VA_JSB, ! fetch from word array 

0 BASSFET_FA_L_R8 : VA_JSB, ! fetch from longword array 
1 BASSFET_FA_F_R8 : VA_JSB, ! fetch from floating array 
g BASSFET_FA_D_R8 : VA_JSB, ' fetch from double array 

BASSFET_FA_G_R8 : VA_JSB, ! fetch from gfloat array 

4 BAS SEE T FAH ARE : VAnI8B: ! fetch from Afloat array 

5 BASS$STO_FA_B_R8 : JSB, ! store into byte array 
66 BASS STO FAAWARE : V : An )88 NOVALUE, ! store into word array 
67 BASSSTO-FA_L_R& : VA_JSB NOVALUE, ' store into longword array 
68 BAS$STO_FA_F_R8 : VA_JSB NOVALUE, ! store into floating array 
69 BAS$STO-FA_D_R8 : VA_JSB NOVALUE . ! store into double array 

70 BAS$STO-FA_G_R8 : VA_JSB NOVALUE, ' store into gfloat array 

71 BAS$STO-FA_H-RB : VA_JSB NOVALUE, ' store into hfloat array 

C3 BASSFETCH DESC; ! fetch elem from array of desc 
7 EXTERNAL LITERAL 

re BAS$K_DATTYPERR : UNSIGNED (8); ' Data type error 
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RASSAAT 10 

1-016 

; 177 1190 
3 178 1101 
. an 1136 
; 180 110 
: + + A 1Re 
3 ¢ 1105 
; 1138 
> «(184 11 

3 «6185 1108 
; 186 1109 
: 1B Wit 
3 189 ie 
3; 190 111 
3 391 1114 
3 135 1115 
; 19 1116 
3; 194 1117 
3; «6195 1118 
3; 196 1119 
3; 197 1389 
3; «6198 1121 
; «4199 166 
; 200 112 
; 201 1124 
3 soe 1125 
3; 2 1126 
3; 204 1127 
; $39 1128 
; 06 1129 
3; 207 1130 
; 208 1131 
3; 209 1136 
3 210 113 


bes AX-11 B 
4-S . 


BASRTL 


non 


16-Sep-1 
1e-Sep-1 


984 43:4 
ob2 90:48:46 
GLOBAL ROUTINE BASSNUM ' NUM 
ss 
++ 
FUNCTIONAL DESCRIPTION: 
This routine supports the Basic NUM function. It returns the number of 
rows input in a two dimensional array and the number of elements input 
in a one dimensional errors It uses a chunk of OWN storage because 
those are the Basic semantics. 
FORMAL PARAMETERS: 
NONE 
IMPLICIT INPUTS: 
NUM. rl 
IMPLICIT OUTPUTS: 
NONE 
! ROUTINE VALUE: 
NUMBER_OF _ELEMENTS.wl.v number of elements read on Last MAT INPUT, LINPUT, or READ. 


SIDE EFFECTS: 


' 
i 
i 
i 
i 
i 
i 
i 
i 
i 
i 
i 
i 
i 
The number of elements or rows read 
i 

i 

i 

1 

i 

' 

! 

' 

' 

' 

te 


BEGIN 
RETURN .NUM 
END; 


End of BASSNUM 


TITLE BASSMAT_IO 
“IDENT \1-016\ 
.PSECT _BAS$SDATA,NOEXE, PIC,2 
00000000 00000 NUM: —.LONG 0 
00000000 00004 NUM2: LONG 
.EXTRN STRSFREE1_DX, BASSSBLNK LINE 
TEXTRN BASSSUDF_RL1. BASSSUDF QL 
TEXTRN BASSFETCA_BFA, BASSSTORE_BFA 
“EXTRN BASSSSTOP; BASSSCB_GET 
“EXTRN BASSFET_FA_B_R8 
“EXTRN BASSFET~FA~W_RB 
TEXTRN BASSFET"FA-L_RB 
TEXTRN BASSFET"FA-F_R 
TEXTRN BASSFET~FA-D-R 
TEXTRN BASSFET"FA-G_R 
“EXTRN BASSFET"FA-H-R 
-EXTRN BASSSTO“FA~B-R 
TEXTRN BASSSTO"FA~W-RB 
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X-11 gt HL v4 0-743 
ASRTL.SRCJBASMATIO.B32;1 

EXTRN BAS$STO_FA_L_R 

-EXTRN BASS$STO-FA_F_R 

.EXTRN BAS$STO"FA-D-R 

-EXTRN BASS$STO-FA-G-R 

-EXTRN BASS$STO-FA-H-R 

-EXTRN BASSFETCH_BESC, BASSK_DATTYPERR 


-PSECT _BASSCODE,NOWRT, SHR, PIC,2 


0000 00000 -ENTRY BASSNUM, Save nothing 
50 00000000' EF 00 00002 MOVL NUM, RO 
04 00009 RET 


; Routine Size: 10 bytes, Routine Base: _BASSCODE + 0000 


; ait 1134 1 
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; 13 1135 1 GLOBAL ROUTINE BASSNUM2 ' NUM2 

3 14 11 § 1 : s 

3 15 11 1 

; 216 1138 1 !+¢ 

: a8 1125 ! FUNCTIONAL DESCRIPTION: 

3 19 1141 1! This routine supports the Basic NUM2 function. It returns the number 
3 sso 1178 : of elements entered in the Last row of a 2 dimensional array or 0 
: $53 1144 1 ! FORMAL PARAMETERS: 

; 23 1145 1! 

: $¢ 1146 1! NONE 

3 5 1147 1! 

; 226 1148 1 =! IMPLICIT INPUTS: 

> 227 1149 1 | 

; $58 ‘te : NUM2. rl The number of elements read in the last row or 0 
; 230 1126 1 ! IMPLICIT OUTPUTS: 

3; 231 115 1! 

3 $36 1154 1! NONE 

3 2s 1155 1! 

>; «234 1156 1 ! ROUTINE VALUE: 

3 239 337 3% 

; 236 1158 1! NUM_OF __ELEMENTS.wl.v number of elements 

3; es? 1159 1! 

; 238 1160 1 ! SIDE EFFECTS: 

; 239 1161 1! 

3; 240 BP 1 !-- 

s 626) 1163 1 

3 seg 1164 2 BEGIN 

; 24 1165 2 RETURN .NUM2 

3 244 1166 1 END; ! End of BASSNUM2 


0000 00000 -ENTRY BASS$NUM2, Save nothing 
50 00000000" EF »? yt OVL NUM2, RO 


; Routine Size: 10 bytes, Routine Base: _BASS$CODE + 000A 


3: 245 1167 1 
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INIT, Save nothing 


NUM 


ENTRY BASSSNUM 


CLAL 
RET 


EF 
_BASSCODE + 0014 


00000000° 
Routine Base: 


9 bytes, 
1200 1 


3; Routine Size: 
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ee 


SRLEARGNLSS 


WAIN 


—— 
No 


GLOBAL ROUTINE BASSSNUM2_INIT 
: NOVALUE = 


—> 


wn 


tee 


; FUNCTIONAL DESCRIPTION: 
This routine initializes NUM2 to 0. 
i FORMAL PARAMETERS: 

; NONE 

IMPLICIT INPUTS: 

NONE 

IMPLICIT OUTPUTS: 
; 
; 
4 
! 
; 
; 
; 
' 
'e 


: ROUTINE VALUE: 
NONE 
: SIDE EFFECTS: 


BEGIN 
NUM2 = 0; 
RETURN; 
END; 


WAIN NININONINUNNND 2 2 OS SS OOO Oooo 
ESE 


NH OOCONOUESWN—OOONOULSUYT—00@ 
III at st hk dt 
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000C 00000 
00000000" EF 04 00002 
04 00008 


; Routine Size: 9 bytes, Routine Base: _BASSCODE + 001D 


, Bs 


1233 (1 


! Initialize NUM2 


NUM2 wl Number of columns in last row. 


! End of BASSSNUM2_INIT 


sENTRY BASSSNUM2_INIT, Save nothing 
CLRL NUM2 
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Data Type Error 


dD 5 
16-Sep-1984 00:43:4 AX-11 Bliss-32 V4.0-74 
12-308-13be 90:8595 EBASRTL’ SRe BASMATIO.832;1 
1234 GLOBAL ROUTINE BASSOUT_MAT_S ( ! Matrix print, semicolon format 
! 5 ARRAY, SUBSCRIPT1,~SUBSCRIPT2) : NOVALUE = 
1 $ 'e¢ 
! 3 FUNCTIONAL DESCRIPTION: 
1240 i The array is printed one element at a time with the elements in each row 
1241 ; being printed in a packed format. Each row begins on a new Line. Row 
: 4g and column zero are not printed. 
1 re ; FORMAL PARAMETERS: 
46 i ARRAY .rx.a ! array to print 
47 ! bor tt et a at ! first optional subscript 
rt SUBSCRIPT2.rlu.v ! second optional subscript 
30 ; IMPLICIT INPUTS: 
3¢ i NONE 
5 ! 
$2 IMPLICIT OUTPUTS: 
33 NONE 
33 } COMPLETION CODES: 
6 i NONE 
6 ! 
6 : SIDE EFFECTS: 
; Signals: 
i 
i 


BEGIN 


GLOBAL REGISTER 
CCB = K_CCB_REG : REF BLOCK C, BYTE); 


BUILTIN 
ACTUAL COUNT; 


LITERAL 
V_1D_FLAG = 1, 
K"ONE_OPT_ARG = 2, 
K_TWO_OPT_ARGS = 3, 
K_1D = 1; 


LOCAL 
NUM_ELEMS_DONE, 


L 
TEMP_STORE : VECTOR (4, LONG), 
COLUMN, 


flag - one dimen. array 
value of arg. count for one 
optional argument 

value of arg. count for two 
optional arguments 

one dimension 


total number of array elements processed 


temp storage for calling FETCH_VA 
current value of subscript 1 
current value of subscript 2 


Oe a ed od nd ed ed ed 
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! upper bound for 1 dimensional 
! array and number of rows for 2 
! dimensional array 

TOTAL NUM_ITEMS, total number of items . the array 
! 
' 


' excluding row and col. 
ELEM_DESCRIP : REF BLOCK fig OvTEI. 


! desc fetched from array 
NUM_BESCRIP : BLOCK BYTE ! numeric desc for FETCH 
MAP 


ARRAY : REF BLOCK [, BYTE]; 
BASS$$CB_GET (); 


i Check to see if this a list of arrays. If it is, then print a blank Line between 
: each array. 


UPPER_BOUND1, 


— —) 9 4 


IF .CCB CISBSV_MAT_PRINT] THEN BASSSBLNK_LINE (); 
CCB _CISBSV_MAT_PRINT) = 1; 
FLAGS = 0; 


: Default TEMP_STORE to a dynamic stirng descriptor 


TEMP STORE [03 = 8x°02060000"; 
TEMPTSTORE £1) = %X'00000000': 


Check the number of dimensions and set a flag if only one dimension. 


IF .ARRAY CDSCS$B_DIMCT] EQL K_1D THEN FLAGS = .FLAGS + V_1D_FLAG; 
1s 
: Check for optional arguments. If there are no optional arguments, then set 


: the upper bounds based on what is in the descriptor. If there are optional 
args, then use them as the upper bound. 


IF ACTUALCOUNT () LSS K_ONE_OPT_ARG 
THEN 


IF _.ARRAY CDSC$B_DIMCT) EQL K_1D 
THEN 


'¢ 
No optional arguments and a one dimensional array 


BEGIN 
UPPER_BOUND1 = .ARRAY [U1_1D); 
TOTAL-NUM_ITEMS = .UPPER_BOUND1; 


'¢ 
2 dimensional array 


UPPER_BOUND! = .ARRAY [U2_2D); 
TOTAL-NUM_ITEMS = .ARRAY [U1_20]*.UPPER_BOUND1; 
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END; 
IF ACTUALCOUNT () GEQ K_ONE_OPT_ARG 
THEN 


BEGIN 
UPPER_BOUND1 = .SUBSCRIPT1 
T SUBSCRIPT1; 


OTAL_NUM_ITEMS = . 
END; 
IF ACTUALCOUNT () EQL K_TWO_OPT_ARGS 
- THEN 
2 optional arguments 


BEGIN 
UPPER_BOUND1 = .SUBSCRIPT2; 
TOTAL NUM, ITEMS = ,SUBSCRIPT1®. SUBSCRIPT2; 


'¢ 
Initialize the two current subscripts regardless of the number of dimensions 
"ROW = COLUMN = NUM_ELEMS_DONE = 1; 

i Check for array of descriptors. They cowld be dynamic opr ine descriptors, 

! or numeric descriptors for a dynamically mapped arra Fetc 


: an element (a descriptor) from the array and check the dtype to 
determine if this is a string array or numeric array. 


1F ARRAY [DSC$B_DTYPE) EQL DSC$K_DTYPE_DSC 
BEGIN 


NUM_DESCRIP CDSCEA _POLMTERD = TEMP_STORE (0); 


IF FLAGS AND V_1D7F 
ELEM_DESCRIP = BASSFETCH_DESC (.ARRAY, 1) 
ELEM_DESCRIP = BASSFETCH_DESC (.ARRAY, 1, 1); 


CAGE FLER DESCRIP CDOSC$B_DTYPE] FROM DSC$K_DTYPE_B TO DSCS$K_DTYPE_H OF 


PORE BB BMA ANNAN HINA IEA GPP POP PININIPURIPUPINPIPUDRIPI NIPPON NIP WIUPnonofny 


CDSCSK_DTYPE_T) : ' text 
(DSC$K_DTYPE_B) : ' byte 
BEGIN 
UM_DESCRIP [DSCSB_CLASS) = DSCSK_CLASS. 5; 
NUM"DESCRIP (DSC$B~DTYPE) = DSCSK-DIYPE-B: 
NUM”DESCRIP DSCSWTLENGTH] = %UPVAL/4; 
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CINRANGE , OUTRANGE 
BASS$STOP (BASSK_DATTYPERR); 


TES; | 
_ END; 
i Loop thru the array descriptor until all of the elements in the array or as 


! specified by the optional arguments have been printed. Start each row on a 
new Line. 


WHILE .NUM_ELEMS_DONE LEQ .TOTAL_NUM_ITEMS DO 
BEGIN 


'¢ 

58 ! Based on the data type. JSB or CALL the proper fetch routine to get the element 
559 ' out of the array. e FETCH and STORE routines are called because the array 
rs may be virtual. 
56 : 

27 an ae CDOSCSB_DTYPE] FROM DSCSK_DTYPE_B TO DSCSK_DTYPE_H OF 

65 

08 COSCSK_DTYPE_B) : 

68 IF .FLAGS AND V_1D_FLAG 
569 


~ 
So 


TEMP_STORE (0) = BASSFET_FA_B_R8 (.ARRAY, .COLUMN) 
TEMP_STORE (0) = BASSFET_FA_B_RB& (.ARRAY, .ROW, .COLUMN); 
CDSCSK_DTYPE_w) : 
IF_.FLAGS AND V_1D_FLAG 
TEMP_STORE (O] = BASSFET_FA_W_RB& (.ARRAY, .COLUMN) 
TEMP_STORE (0) = BASSFET_FA_W_R& (.ARRAY, .ROW, .COLUMN); 
CDSCSK_DTYPE_LJ : 
IF .FLAGS AND V_1D_FLAG 
TEMP_STORE (0) = BASSFET_FA_L_R8 (.ARRAY, .COLUMN) 
TEMP_STORE [0] = BASSFET_FA_L_R8 (.ARRAY, .ROW, .COLUMN); 
CDSCSK_DTYPE_FJ : 
IF_.FLAGS AND V_1D_FLAG 
TEMP_STORE [0] = BASSFET_FA_F_R& (.ARRAY, .COLUMN) 
TEMP_STORE [0] = BASSFET_FA_F_R& (.ARRAY, .ROW, .COLUMN); 
CDSCSK_DTYPE_D) : 
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; 6 1 300-1 3c 99:88:95 EBASRTL SRE BASMATIO.B39;1 - (7) 
; 600 151 F_.FLAGS AND V_1D_FLAG 
; 601 1 8 if N hes, 
3 one ! 1 euseree oS TOne CO] = BASSFET_FA_D_RB (.ARRAY, .COLUMN) 
; O06 1 5 TEMP_STORE [0] = BASSFET_FA_D_R® (.ARRAY, .ROW, .COLUMN); 
; ope 1525 CDOSCSK_DTYPE_T] : 
; 60 1 $ 
; ons ; 8 IF .FLAGS AND V_1D_FLAG 
; 2i9 : 2 BASSFETCH_BFA (.ARRAY, TEMP_STORE [0], .COLUMN) 
; ol¢ : 1 BASSFETCH_BFA (.ARRAY, TEMP_STORE [0], .ROW, .COLUMN); 
; 614 1 : COSCSK_DTYPE_DSC) : 
; 615 1534 
3 O18 1535 4 BEGIN 
; (61 1536 4 CASE .ELEM_DESCRIP CDSCS$B_DTYPE] FROM DSC$K_DTYPE_B TO DSC$K_DTYPE_H OF 
2 ee " 
; 620 1539 4 CDSCSK_DTYPE_B, DSCSK_DTYPE_W, DSCSK_DTYPE_L, DSCSK_DTYPE_F 
; 621 1540 4 DSCSK-DTYPE-D, DSCSK~DTYPE-G, DSCSK-DTYPE-H, DSCSK-DTYPE_P3 
3; 8 ¢ 1541 H BEGIN 
; 6 1366 
3 624 154 é TEMP_STORE (0) = %x‘'00000000'; 
: £36 1302 é IF .FLAGS AND V_1D_FLAG 
3 6 5 1546 5 BASSFETCH_BFA (. ARRAY, NUM_DESCRIP, .COLUMN) 
; 628 1547 : ELS 
; 680 1368 2 BASSFETCH_BFA (. ARRAY, NUM_DESCRIP, .ROW, .COLUMN); 
; «631 1550 4 END; 
; O36 1551 4 
; 63 1236 4 COSCSK_DTYPE_T] : 
; 634 1553 4 
; 635 1554 4 IF .FLAGS AND V_1D_FLAG 
; 636 1555 4 
3; 637 1336 Se BASSFETCH_BFA (.ARRAY, TEMP_STORE (OJ, .COLUMN) 
; 638 1557 4 ELSE | 
; O72 1338 é BASSFETCH_BFA (. ARRAY, TEMP_STORE [0], .ROW, .COLUMN); | 
3; «(641 1560 4 CINRANGE ,OUTRANGE]) : 
; 64¢ 1561 4 BASS$STOP (BASSK_DATTYPERR); 
3; 64 1308 4 
3 644 1565 4 TES; 
3; 645 1564 4 
3 ose 1565 END; ! end of dtype dsc 
; 64 1296 
; 648 156 CDOSCSK_DTYPE_P) : 
; 649 1308 '¢ 
; 650 136 ! Must pass a descriptor to BASSSUDF_WL1. Construct aclass SD 
; $3) 1309 descriptor here, and set the pointer field to TEMP_STORE. 
; £38 1376 4 BEGIN 
3 654 1575 4 UM_DESCRIP pscee cL Ass) = DSCSK_CLASS_SD; 
; 655 1574 4 NUM- DESCRIP [DSC$B_DTYPE) = DSCSK_DTYPE P; 
; 656 1575 4 NUM“DESCRIP CDSCSWILENGTH) = .ARRAY CDSCS$W_LENGTHI; 


soot 
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BASSMAT 10 b-s 3een ike § 


0: $3: $6 arent Ot sgang V4.0-7 Page 16 
Serr! COSC$B SGALEI: 
EMP_STORE [0]; 


1 
1 BASR BASMATIO.B3 i1 (7) 
NUM_DESCRIP (DSCS$B_SCAL nf 


5 $07 1376 4 oa 

; 698 , 4 NUM-DESCRIP CDSCSA-POINTER) T 

; 660 23 4 IF jFLacs AND V_1D_FLAG 

; 66¢ 1 4 BASSFETCH_BFA (.ARRAY, NUM_DESCRIP, .COLUMN) 

5 664 13 é 4 <0 BASSFETCH_BFA (.ARRAY, NUM_DESCRIP, .ROW, .COLUMN); 
; 666 1585 

; 66 1 6 CDSC$K -DIVPE G] : 

: $68 ' $4 IF~.FLAGS AND V_1D_FLAG 

; 670 1389 TEMP_STORE [0] = BASSFET_FA_G_R8 (.ARRAY, .COLUMN) 
: 672 1391 TEMP_STORE (0) = BASSFET_FA_G_R8 (.ARRAY, .ROW, .COLUMN); 
: 674 1898 LDSCSK_DTYPE_H) : 

: 675 1594 

; 676 1595 IF .FLAGS AND V_1D_FLAG 

3; 677 1396 THEN 

: 678 1397 - TEMP_STORE [0] = BASSFET_FA_H_R8 (.ARRAY, . COLUMN) 
: 680 1599 TEMP_STORE [0] = BASSFET_FA_H_R8 (.ARRAY, .ROW, .COLUMN); 
5 68 1601 CINRANGE, OUTRANGE) : 

: 68 1608 BASS$STOP (BASS$K_DATTYPERR); 

; 684 160 TES; 

; 685 1604 

; 686 1605 BASSSUDF WL ( 

. rte wy 

; 689 1608 4 IF (.ARRAY CDSCS$B_DTYPE] EQL DSC$K_DTYPE_DSC) THEN .ELEM_DESCRIP CDSCS$B_DTYPE] ELSE .ARRAY CDSCS 
: 691 1610 4 END 

: 69 1611 3 . 

: 69 lore 4 BEGIN 

+ 694 1613 4 

: 695 1614 4 TEMP_STORE : BLOCK (8,B8YTE); 

3; 696 1615 4 

: 697 1616 2 (IF .ARRAY CDSC$B_DTYPE] EQL DSCSK_DTYPE_T 

+ 698 161 THEN 

; 699 1618 3 ’ .TEMP_STORE COSC$W_LENGTH) 

: 701 16 0 6 UF jARRAY CDSC$B_DTYPE] EQL DSC$K_DTYPE_DSC 

> 70 16 2 6 IF .ELEM_DESCRIP CDSC$B_DTYPE) EQL DSC$K_DTYPE_T 

3; 704 16 6 THEN 

+ 705 1624 6 .TEMP_STORE CDSC$W_LENGTH) 

; 706 1625 6 ELS 

> 70 16 6 é .NUM_DESCRIP CDSC$W_LENGTH) 

: 708 16 ‘ ELS 

: 709 1628 ARRAY CDSC$W_LENGTH))) 

; 710 1629 4 END 

: 711 1630 3 - 

; ole 1631 4 (IF ARRAY CDSC$B_DTYPE) EQL DSCS$K_DTYPE_P 

: 71 1632 4 THEN 


K § 
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| | 


pA vescnir ! pass dsc for packed 
(IF ARRAY Sth Lobe t EQL pscex fis DSC AND 
. geLER pesca? DSCSB_DTYPE) EQC DSCSR_DTYPE_P 
NUM_DESCRIP 
LSE 


TEMP_STORE)), 
! If this is the last element of this row, then pass the ‘'no format" 
! argument so that the first element of the next row starts on a 
! new Line 
BEGIN 
IF (. COLUMN EQL .UPPER_BOUND1) THEN BASSK_NO_FORM ELSE BASS$K_SEMI_FORM 
END 


3 
NUM_ELEMS_DONE = .NUM_ELEMS_DONE + 1; 
COLOMN = [COLUMN + 1; 


aa GTR .UPPER_BOUND1 
BEGIN 
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7 '¢ 
; It is time to start a new row. 
740 : ROW = .ROW + 1; 
741 COLUMN = 1; 
2% END; 
eee END; ! end of the WHILE loop 
746 6 ‘+ 
SH 6 Return any temporary storage used and then return 
749 
750 IF ARRAY FDSC$B_DIVPE EQL DSCS$K_DTYPE_T OR 
751 7 (ARRAY CDSC$B"DTYPE] EQL DSC$K"DTYPE-DSC AND 
2¢ , jELEM_DESCRIP DSC$B_DTYPE) EQC DSCS$R_DTYPE_T) 
134 , STRSFREE1_DX (TEMP_STORE); 
756 7 RETURN; 
757 7 END; ‘End of BASSOUT_MAT_S 
OFFC 00000 -ENTRY BASSOUT MAT_S, Save R2,R3,R4,R5,R6,R7,R8,- 5; 1234. 
SE 0 ¢2 9002 SUBL2 #48, SP : | 
000000006 00 16 00 JSB BAS$S¢B GET ; 13 
07 9 AB H E1 000 BH , ~105(CCB), 1$ 31 
000000006 0 FB 01 CALL #0, BASSSBLNK_LINE ; 
AB 4 88 00017 1$: BISB2 #4, -105(CCB) ; 3 0 
08 AE D4 0001B CLRL —s- FLAGS > 1311 
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; Routine Size: 883 bytes, Routine 
; 758 1677 1 


9 02 Ag 


1 ae 

> 5 

15 02. AA 

06 

51 1c AE 

04 

51 24 a 

0 30 
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7E 28 =OAE 

1¢ 

18 50 
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OE 02. AA 

06 

51 28 «AE 
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51 20 A 
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00 01 
Base: _BASSCODE + 
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1 00 

0 00 

B 003 

6 0034 

6 0034 

1 told 

5 00348 

6 00340 

0 00350 

1 ORez 738: 
1 00356 74$: 
3 0035A 

1 0035C 

2 00 ¢ 

} 036 

F $368 758: 
B 00368 

4 00372 76$: 
0026 
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2(R9), RO 
RO, # 


31 
RO, #26 
(ELEM_DESCRIP), #21 
NUM_DESCRIP, R1 

es 
TEMP_STORE, R1 
RO, #14 
66$ 

TEMP_STORE, (SP) 
70$ 

R § #24 
e{ELEM_DESCRIP), #14 
TEMP_STORE. R1 
NUM_DESCRIP, R1 
(R9), R1 

RO #26 
¢{ELEM_DESCRIP), -(SP) 
2$ 

RO 
#4, BASSSUDF WLI 
Nua ELEMS_DONE 
COLUMN, UPPER_ROUND1 


ROW 
#1, COLUMN 


(RO), #14 

(RO), #24 
G{ELER_DESCRIP). #4 
6$ 


TEMP_STORE 
#1, STRSFREE1_DX 


toe 
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p-19 BASRTL.SRCJBASMATIO.B 

760 1678 1 GLOBAL ROUTINE BASSOUT_MAT_C ( ! Matrix print, comma format 
3 761 1679 1 ! array to print 

: 76 1680 1 SUBSCRIPT1, i first optional subscript 

; 76 1681 1 SUBSCRIPT2 ! second optional subscript 

; 764 16 ¢ 1 ) : NOVALUE = 

; 6? ig 4 i 'ee 

; 167 16 3 i FUNCTIONAL DESCRIPTION: 
3 769 1687 1: The array is printed one element at a time with the elements in each row 
; 770 1688 1! being printed in a print zone. Each row begins on a new Line. Row 

3 44 108) : } and column zero are not printed. 

: ah 1691 | FORMAL PARAMETERS: 

: 775 1698 i ARRAY .rx.a ! array to print 

: 776 1694 1! pease niet) -riu.v : first optional subscript 

: ade 1232 : SUBSCRIPT2.rlu.v ! second optional subscript 

: 779 1899 1 | IMPLICIT INPUTS: 

; 780 1698 1! 

oi) 

: 78 1701 1! IMPLICIT OUTPUTS: 

; 784 17 1! 

eit i= 

: 787 1705 1 } COMPLETION CODES: 

; 788 1706 1! 

: 550 1708 1 i _ 

; 791 1709 i SIDE EFFECTS: 

: 79 1711 1: Signals: 

; 796 at : 2 Data Type Error 

; 795 171 1! 

; 796 1714 1 I< 

; 797 1715 «1 

3 as fA BEGIN 

> 800 1718 GLOBAL REGISTER 

; it ah CCB = K_CCB_LREG : REF BLOCK C, BYTE); 

: 80 1731 BUILTIN 

3 Be iz ; ACTUAL COUNT; 

; B06 1726 LITERAL 

; 807 1725 V_1D_FLAG = 1, ! flag - one dimen. array 

; 808 17 g K-ONE_OPT_ARG = 2, ! value of arg. count for one 
: 809 17 ! optional argument 

; 810 17 3 K_TWO_OPT_ARGS = 3, ! value of arg. count for two 
: at) 17 ! optional arguments 

3 i 1730 K_1D = 1; ! one dimension 

: Bi. 1732 LOCAL 

: 15 1538 NUM_ELEMS_DONE, ! total number of array elements processed 
; 816 1734 FLAGS, 


i 


(ee 


6 

—BASSMAT_I1O 1-56 1984 00:43:4 AX-11 Bliss-32 V4.0-74 Pa 4 
1-016 12-80 8=1 Oke 99:88:48 EBASRTL SRe BASMATIO.OS9:1 ” BS 
'3; 817 1735 TEMP_STORE : VECTOR (4, LONG), ! temp storage for colt ing FETCH_VA 
is i 17 § ROW, ! current value of subscript 1 
is 61 17 COLUMN ! current value of subscript 2 
$820 17 : UPPER_BOUND1, i upper bound for 1 dimensional 

: 1 17 ' array and number of rows for 2 

3 ¢ 1740 ! dimensional ervey 

3 1741 TOTAL NUM_ITEMS, ! total number of items in the array 

3 4 16 ! excluding row and col. 0 

: 5 174 ELEM_DESCRIP : REF BL 9CK £1¢ OTE), ! desc fetched from array 

; § eee NUM_BESCRIP : BLOCK (8,BYTEJ; ! numeric desc for FETCH 

: 174 MAP 

2 3 : 1247 ARRAY : REF BLOCK C, BYTE); 

; Ht 1749 BASSS$C(B_GET (); 

: 8 ‘ 1784 i Check to see if this a List of arrays. If it is, then print a blank Line between 

3 it 1736 ' each array. 

: He pee " 

; 837 173 IF .CCB CISBS$V_MAT_PRINT] THEN BASSSBLNK_LINE (); 

: 839 1785 CCB CISB$V_MAT_PRINT) = 1; 

3 at 1738 FLAGS = 0; 

; rh 1790 ! Default TEMP_STORE to a dynamic stirng descriptor 

; 844 1768 >  —«*TEMP_STORE £0} = %X'020E0000'; 

; Bez ieee TEMP_STORE (1) = %x'00000000'; 

3 847 1765 i Check the number of dimensions and set a flag if only one dimension. 

: Beco ee 5 

; 850 1768 IF .ARRAY CDSC$B_DIMCT] EQL K_1D THEN FLAGS = .FLAGS * V_1D_FLAG; 

: Bea 1790 5 16 

; Hs 1771 i Check for optional arguments. If there are no optional orgunents. then set 

: 854 1778 : the upper bounds based on what is in the descriptor. If there are optional 

3 859 177 ! args, then use them as the upper bound. 

: Bs nes 5° 

; 858 1778 IF ACTUALCOUNT () LSS K_ONE_OPT_ARG 

3 £2? tA THEN 

; Hg 1598 IF ARRAY CDSC$B_DIMCT) EQL K_1D 

Dt Se Piiben 

; 864 178¢ No optional arguments and a one dimensional array 

; Beg pb BEGIN 

; 86 1785 UPPER_BOUND! = .ARRAY [U1 1D); 

; 868 1786 TOTAL-NUM_ITEMS = .UPPER_BOUND1; 

; 869 17 END 

; 870 1788 ELSE 

; 4 17 ; = BEGIN 

: ig 1791 i 2 dimensional array 


i — ie 
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1-016 1o-308- 1382 90:98:48 EBASRTL’ SRe BASMAT IO. B35; 1 se (83 
; 874 1733 '- 
; 75 179 UPPER_BOUND1 = .ARRAY [U2 2D); 
: 87 1794 TOTALNUM_ITEMS = .ARRAY [U1_20]*.UPPER_BOUND!; 
3 . 10%? END; 
: HY 1599 IF ACTUALCOUNT () GEQ K_ONE_OPT_ARG 
; 880 1798 THEN 
; #881 17 BEGIN 
; 8 1800 UPPER_BOUND1 = .SUBSCRIPT1; 
; 88 1801 TOTAL-NUM_ITEMS = .SUBSCRIPT1; 
3 44 1306 END; 
; He 1804 IF ACTUALCOUNT () EQL K_TWO_OPT_ARGS 
; 887 1805 THEN 
; 888 1308 '¢ 
; 889 180 ! 2 optional arguments 
; 890 1808 te 
: 691 1809 BEGIN 
; 89 1810 UPPER_BOUND1 = .SUBSCRIPT2; 
; 89 1811 TOTAL _NUM_ITEMS = . SUBSCRIPT1®. SUBSCRIPT2; 
> 894 a END; 
; 895 181 
; 896 1814 !¢ 
3 344 a Initialize the two current subscripts regardless of the number of dimensions 
3 are 1817 ; ROW = COLUMN = NUM_ELEMS_DONE = 1; 
; 901 1819 : Check for array of descriptors. They could be dynamic spring descriptors, 
3 o08 1820 ! or numeric descriptors for a dynamically mapped orrey. Fetc 
:; 90 1821 : an element (a descriptor) from the array and check the dtype to 
3 ope ‘3 ; } determine if this is a string array or numeric array. 
3 906 18 4 IF .ARRAY CDSCSE_DTYPE] EQL DSC$K_DTYPE_DSC 
; 907 1825 THEN 
; 908 18 § BEGIN 
: 909 18 
; 910 1828 NUM_DESCRIP CDSCSA_POINTER] = TEMP_STORE [0]; 
; 911 136) IF _.FLAGS AND V_1D_FLAG 
; aig 1830 THEN 
3 a 133 ELEM_DESCRIP = BASSFETCH_DESC (.ARRAY, 1) 
; 915 1833 ELEM_DESCRIP = BASSFETCH_DESC (.ARRAY, 1, 1); 
: Bis 1833 
; 918 36 CASE -ELEM_DESCRIP CDSCS$B_DTYPE] FROM DSCSK_DTYPE_B TO DSCSK_DTYPE_H OF 
: 920 1 HA 
: 921 1839 CDSCSK_DTYPE_T) : ' text 
: 9 ; 1840 
; F 1841 3 
3 9246 1 § 
; 925 1 CDSCSK_DTYPE_B) : ! byte 
3; 9 $ 1844 
; 9 1845 4 BEGIN 
: 928 1 § 4 
3 544 1 4 
; 930 1848 4 
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3 eee ! END; 

; 350 1908 CINRANGE ,QUTRANGE 

; 991 190 BASS$STOP (BASSK_DATTYPERR); 

; 398 191 TES; 

> 994 1318 

; 995 ba - END; 

: 999 1915 i Loop thru the array descriptor until all of the elements in the array or as 
; 998 1218 ! specified by the optional arguments have been printed. Start each row on a 
; .999 191 ! new Line. 

pg 

; 1008 1920 WHILE .NUM_ELEMS_DONE LEQ .TOTAL_NUM_ITEMS DO 

; 1003 19 1 2 BEGIN 

+ 1005 19 : i Based on the data type. JSB or CALL the proper fetch routine to get the element 
3 He 1924 ' out of the array. e FETCH and STORE routines are called because the array 
; 100 1925 ! may be virtual. 

fet oe 

; 1010 1928 CASE .ARRAY CDSCSB_DTYPE] FROM DSCS$K_DTYPE_B TO DSC$K_DTYPE_H OF 
BU RG we 

; 1918 1931 CDSCSK_DTYPE_B) : 

; 1015 19 4 IF FLAGS AND V.1D_FLAG 

; 1917 19 5 a TEMP_STORE (0) = BASSFET_FA_B_R8 (.ARRAY, .COLUMN) 

; 1019 1987 TEMP_STORE [0] = BASSFET_FA_B_R8 (.ARRAY, .ROW, .COLUMN); 
; 1021 1938 CDSC$K_DTYPE_w) : 

; 19 5 1941 IF FLAGS AND V,1D_FLAG 

; 19 5 1948 se ene STORE (0) = BASSFET_FA_W_R8 (.ARRAY, .COLUMN) 

; 1037 1945 TEMP_STORE (CO) = BASSFET_FA_W_R8 (.ARRAY, .ROW, .COLUMN); 
; 1089 1367 CDSCSK_DTYPE_LJ : 

: i 1 1948 IF .FLAGS AND V_1D_FLAG 

: 1038 1951 TEMP_STORE (0) = BASSFET_FA_L_RB® (.ARRAY, .COLUMN) 

; 1035 1988 TEMP_STORE [0] = BASSFET_FA_L_R8 (.ARRAY, .ROW, .COLUMN); 
: it! 195 CDSCSK_DTYPE_FJ : 

; 1039 1987 IF FLAGS AND V,1D_FLAG 

; 104) 1988 te TEMP_STORE [0] = BASSFET_FA_F_R8 (.ARRAY, . COLUMN) 

: 1028 1961 TEMP_STORE (0) = BASSFET_FA_F_RB (. ARRAY, .ROW, .COLUMN); 
3 1044 1962 


— 


r 
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CDSCSK_DTYPE_DJ : 
IF «FLAGS AND V_1D_FLAG 
TEMP_STORE [0] = BASSFET_FA_D_R& (. ARRAY, .COLUMN) 
TEMP_STORE [0] = BASSFET_FA_D_RB (.ARRAY, .ROW, .COLUMN); 
CDSCSK_DTYPE_T) : 
IF_.FLAGS AND V_1D_FLAG 
BASSFETCH_BFA (.ARRAY, TEMP_STORE [0], .COLUMN) 
os BASSFETCH_BFA (. ARRAY, TEMP_STORE (OJ, .ROW, .COLUMN); 
COSCSK_DTYPE_DSC) : 
BEGIN 
CASE ELER_DESCRIP COSC$B_DTYPE] FROM DSCSK_DTYPE_B TO DSCS$K_DTYPE_H OF 
CDSC 
DSC 
STORE CO] = %x*°00000000'; 
FLAGS AND V_1D_FLAG 
BASSFETCH_BFA (. ARRAY, NUM_DESCRIP, .COLUMN) 
BASSFETCH_BFA (. ARRAY, NUM_DESCRIP, .ROW, .COLUMN); 
END; 
CDSCSK_DTYPE_T) : 
1f jftacs AND V_1D_FLAG 
BASSFETCH_BFA (.ARRAY, TEMP_STORE [0], .COLUMN) 
ne BASSFETCH_BFA (. ARRAY, TEMP_STORE [0], .ROW, .COLUMN); 


CINRANGE , OUTRANGE, : 
BASS$STOP (BASSK_DATTYPERR); 


TES; 
END; ! end of dtype dsc 
CDSC$K_DTYPE_PJ : 


i Must pass a descriptor to BASSSUDF _WL1., Construct a cla 
! descriptor here, and set the pointer field to TEMP_STORE 


BEGIN 
NUM_DESCRIP COSCS$B_CLASS) = DSCS$K_CLASS_SD; 
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NUM_DESCRIP DSC$B_OTYPE) = DSCSK_DTYPE_P; 
NUM“DESCRIP CDSCSW-LENGTH) = . ARRAY COSCS$W_LENGTH); 
NUM_DESCRIP [DSCS$B_SCALE] = .ARRAY CDSC$B Rp ated: 
NUM-DESCRIP CDSCSA_POINTER] = TEMP_STORE [0]; 
IF FLAGS AND V_1D_FLAG 


BASSFETCH_BFA (. ARRAY, NUM_DESCRIP, .COLUMN) 
wo BASSFETCH_BFA (.ARRAY, NUM_DESCRIP, .ROW, .COLUMN); 


CDSC$K_DTYPE_G) : 
If FLAGS AND V_1D_FLAG 
eve ENP = STORE [0] = BASSFET_FA_G_R8 (.ARRAY, . COLUMN) 
TEMP_STORE [0] = BASSFET_FA_G_R8 (.ARRAY, .ROW, .COLUMN); 
CDSCS$K_DTYPE_H) : 
IF _<FLAGS AND V_1D_FLAG 
TEMP_STORE [0] = BASSFET_FA_H_R8 (.ARRAY, .COLUMN) 
TEMP_STORE [0] = BASSFET_FA_H_R8 (.ARRAY, .ROW, .COLUMN); 


CINRANGE, OUTRANGE) : 
inn BASS$STOP (BASS$K_DATTYPERR); 


BASSSUDF Wii ¢ 
BEGIN 


IF (.ARRAY CDSCSB_DTYPE] EQL DSCSK_DTYPE_DSC) THEN .ELEM_DESCRIP CDSC$B_DTYPE] ELSE .ARRAY CDSC$ | 
END 
BEGIN 
TEMP_STORE : BLOCK (8,BYTE); 
dF yAnRay CDSC$B_DTYPE] EQL DSC$K_DTYPE_T 
.TEMP_STORE COSC$W_LENGTH) 
UF yARRAY CDSC$B_DTYPE] EQL DSC$K_DTYPE_DSC 
IF .ELEM_DESCRIP COSCSB_DTYPE] EQL DSCS$K_DTYPE_T 
-TEMP_STORE COSC$W_LENGTH) 
-NUM_DESCRIP COSC$W_LENGTH] 
-ARRAY CDSC$W_LENGTH))) 


' 
. 


END 


BASSMAT_10 1-90-1984 99:48:45 HBXsare sae deagmatio.as3;1 
(1F_.ARRAY CDSC$B_DTYPE) EQL DSCSK_ptvPE_P 
THEN 


NUM_DESCRIP ' pass dsc for packed 


(IF “erent COSCSB_DOTYPE] EQL DSC$K_DTYPE DSC AND 
M_DESCRIP~CDSC$B_DT Yee EQC DSCSR_DTYPE_P 


 * 
NUM_DESCRIP 
TEMP_STORE)), 


! If this is the Last element of this row, then pass the ‘'no format" 
i argument so that the first element of the next row starts on a 


HEN 

STRSFREE1_DX (TEMP_STORE); 
RETURN; 
END; 
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i ney Line 
(IF . COLUMN EQL ‘wit poet THEN BASSK_NO_FORM ELSE BASSK_COMMA_FOR)); 
NUM ELEMS DONE = sNUALE Ems DONE + 1; 
COLOMN = [COLUMN + 1; 
iV aaa GTR .UPPER_BOUND1 
BEGIN 

99 '¢ 
139 Z It is time to start a new row. 
108 : ROW = .ROW + 1; 
10 COL UMN 1; 
104 END; 
105 
138 END; ! end of the WHILE loop 
108 '¢ 
19) ts Return any temporary storage used and then return 
111 
Ng If .ARRAY CDSC$B optvrey Fe cet DSCSK_DTYPE_T OR 
11 (ARRAY DSC$B_ LSC ek DTYPE-DSC AND 
"3 ELEM _DESCRIP™ DSC$B_ Thee EQC DSC$R_DTYPE_T) 
11 
9 
118 
119 


‘End of BASSOUT_MAT_C 


OFFC 00000 ENTRY BASSOUT IMAT_C, Save R2.R3,.R4,R5,R6,R7,R8,- 
0 C2 9002 SUBL2 SP 
“=, 000000006 0 16 0000 JSB BAS§S(B GET 
7 97 ; E1 0000 BBC , “105(CCB), 1$ 
000000006 $0 Ee 91 CALLS #0, BASSSBLNK “LINE 
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re 


Orn 


mo oOo ~ KOOrOOO [=] coe N NCP Al Al 
~~ eK ~ BRRKRRRRER OOD Wow om wan [- ¢] fo @] 
-—-— Se FSSC SC Se K SEEK SC Ee - eee _ = 
& Se i ed Me Me ed i i i Bd i i i de i i i i i a ee et ee ee eh eh oo oo oe ee ee ee ee ee ee 2 
e 
a 
” 
= 
“4 [vey 
= - 
w — 
—_ =’ 
— 
os 1 = | 
. = 2 
wm = 1 
rer ” ze — 
~@ = t = 
' . ua 4 w _ 
oo Co -< = oO 
oe _ _ w _ wT 
aes ' oO foal oo _ + ~ 
>< = — on as. a ~ 
= = 2 3 2=_ _ ca 
Nw 2 . 2= pl a 
mt - tia O23 oa. vo 5 
'‘@ ow ao a2 o-=- ” wo 
awn 2<z< 2a to xew w =) vw ® 
nv ae S~ ew Qua a w ” 
—c oo om wt wno LY w wa - 
YY Qa- wor are hw 5 a ann 
@- t 4g ao a t t ea 
— ae @e Soe 23MM 2 = mee 
-—- ws wae we = ve VNWa 
-a + aa ac ss . sw . oa Kw 
wo wow - az az -— NNIZ ua vey wan 
<< «co a a wae _—— K—K—wst ww cw Ike 
<o Oc N oO om aam aa © 28 Or i 
> ~ te -@ oz —-—— aanae _ ve) 
we A Am tia t ca @a@mn7oc+ s+ <« 
oe ao Mme MOA AEs YOY s YVuUZven~ ~” @ 
a=<zt <= on aw cw YWR WW Go aw —+Jtitentes 
=< ~ <a ~a ~Qa @0@0aA @@ ++ <awic . 
NL WEO MO 12 HOO MOA 2H D223 MW IE OO 
e— ee VE aw TE OOS ST ONO ONY BRVAV -uU BZzeezewoezezw 
mw 
ww 
oe co PJ mm D> ~*~ | aI UIIIW Da 
or 1WIIDOIIOOVI 1104 1100 JI IJIOOdtertIs FIT TrUuwe 
So— Crea weovtdw@>rge> 26M S>>awr > Sra w>OuoH JHMMMHHu>MOoO 
HO JE Z2SZEZO JIOOCOTODE JOOZZOVDOOCOZZOUDI<Aae DTT aoacFs 
TF VGEVVO—-VYOOTTOZEYOFTTVOSTETSTS ST O®TMAAvYIMAaAaAvzw S- 
on 
Wo 
i) 
aa 
oe oe oo oe oo ee oe oe 
mm oe oe ee Pe cas fA 
> Ns mm" ws w wo La ao o 
oer OC ORM fOr COUIM < Oe TO OWM EWR NO MOT OO KE MIN WW OW OW OW 
NOOO PIII VIN AF TF WT TOWN OO OOPR-P-F- DDDDOOOCOSO Cee eOmooavrvad 
OOCCOCCOCSCOCSCOSOSSOOCOCOCOCOSCOSSOSSOSOOOSOOSOOOCOOCOCOOCOCOOCOOCOOCOOCOOCOOCOOOCOoOO 
OOoOCCOCOCOCOCOCOCOOOOSOCOOCOCOCOOSOOOCSOSOSOOOCOOOSOOOCOOOCOOOOCOOOOOOoOO 
SoqSCCOOOOOC OOOO OCOOSOCCOOCO COSCO OOOSOOOOOOOOOOoOoOOoOO 
TOT —VOOK— WOOO OM & OOK VOMCOCOK— NWS OOG—cacogou. 
OO00— O00 —- WOO OVO — OOB0 — OY OAOOO KK OwOodu--AGO0u080 
WLOCMNOWLDOSE WYER WY LOVOVVV EK KK OOwWwWweKOVNOK— —OMO< OrOwww 
a eae 
Soooooo 
wv 2 [*) wv Dw aoc Vv Nu O@ N 
NO Oo -o WwO oo oo o NO Oo 
oc -_- N Vww WON WWM WeWWwWwO Wo o Oct OMMwwwm@ 
nw Oo oOo odd <eaeto <eaeto eet etwode- «co o Owmowsowruns 
Soooooo 
- oe Coooooo 
reo YO ro vowr wv r=) oS So 
o- om one oo-- oO - o oO 
So =] 
[=] oS 
So [=] 
So oS 
o So 
o So 
ee) vs) Oe WWwWwWPr 
=< =< er cuCucucs.. 
oooooo 
oooooo 
Oo oO 
- - 
tse la 
Sooo 
oO SsSsss 
_ 
g 
a 
<< 
+ 4 
-_ 


Gy 

@PZzaor+r+rrrertereeevrervreenes 
Ww tee eeseeeseeseeseeeseese ee & & & 
XIE APAAAAADAPDDPA BAA ABA AA 
LD AAAAAAAAAAAAAAAS 


.10 


pyaar 


A 


- DOOM -WOtORwDoooOMsNO 


oa [°) 
4 Sasa Sse eww ooowonassese N wre 
10D 6D 6D 60 a0 60 00 0D 6D 60 cD GO GO GOGO OA OA OO o oe 
- De see eee ee cee eh ce ee ee ee ee ce eh ee ee ee ee ee ek el - nm 
eee ee 86 Se Fe Fe Fe FS FS FS FS FS FG FS FS FG FS FS FS FS OS FS FS HPS HS FPS TS HS FS FS HS HS HSS HS HS FS SS FS SS HSS SS HS FS SS HS HS HS HSS SCH HS SCE *S 
w 
= 
uw 
— 
— 
a 
= 
= 
~ 2 
a a a a t 
w — — — ad 
te cz « am oad 
‘ eo vw NN ™ Nn ON veo + +. 
“vw Ww + + +> + ” a ao 
. wwa a a a wa oe 
a aoa = -_— = a «ea 
a a 'aQageacesece«a ' waw « 
w = = Veo kee YY Ue = Moww Nw 
aausd>30%4% “fe 4 “Ee wuwa N 
>o 2aeaw wweiw we 2 awad a 
mh a aw a aw o 
-—w . . t Qu U L ¥¥) - = & . fh 
<a ™ © za = £a SCO JDEZ3DM orretevpepevpeepepeperpeeperenreeeee oO 
sesprsrsreas® » ™ at a aw tS C2aeae Meese seseeseseseseseseeseeseeee ees N 
ess ss 8 wo woz = z2z=ze™ z= w PD LY LD % PLD LO SY LV LY LD LDL PLS PSY Lh LL 
PRHAOOOxMI CO WV = ™w . J So i A Sto >_> Sh ba 
GSoooococesad ~™~ ™ . 4 . seer WW ew POCONO CIC CUINICIICIOUONIOIOIOOIOE 
senepepeg@ewm - wu we OO ~ “oOo NRO ft qmeetetene wo 
PRARMAAAAZ PA ALRHORHO MOMD MOMMA TEMHMATAHAMAHAHAAHAAAGA > > fo Py LL 


F FAA HA FH ASH A GA 
- F- S3T3Tr SFr KF ee NU NUM CUCU 


TOu COMMA DOrt-Ou—f- Dove O-  OCDOomawn ana 
UU ke be O00 NINN CIN ST TFT TOWN OOPR- 
DOCOOC eH KR em RR Rm mR RM OR OR Rm me rr OR mm ee 
SOCCCSOCOCOOCOCOOCOSOSCOOCOOSCOOCOSOOOCOOoOOCCOOCOOCOoOSCSoO 
Sooo OCSoOOCOOCOCOOCOoOOoOOOOoOOoOoOOOCOoOoOoOoOO 


<@O--O-OCO-Or-CO- O- OO- OK COCO eK Menu 
OunOrn-OrO- OO O- OO-SO- OBOCOe-™MaA 


2$: 
$ 
$ 


wee Mer ue Oe FOO DOLE A OOWUMOO CUCL 
DWOMD~TO~TDOWODOUDOWOO-- WOOO Ft BOO IMOOu uu 
Nu OoOCoOoOoOOoOSoO 
o GoOooooo 


Yo 
o - we @O < oa @ ow Ow N 
o oo °o 2& o- -- Oe Oo 
ocUCcolUCc e-hlhU - - o eo 
oo oOo SO o oO o Oo 
oOo ff YL 
o oO - 
- _— 
o oO o 
wo www ww Ww Wa Ww lll WLVorrrw 
~o < «€ <«€ eet &¢«€ tet <« eect OowOuuwu sy 
oooooe, 
o oooooo 
ow wm ct ewo<«t <o © <«DO0O 
Pe ee ee 
o 
So 
o 
o 
oOo 
Or K TO 
w—Oounuuwvwd 
oooooe 
oooooo 
tl a Lad 
fee be be Oe 
ooo-o 
ooooo 


05 


| BASSMAT_I0 
1-016 


Sku. Be. Be Ss (SBS. Se 
o Oo oo oO oo oO oor Oo oOo oO ow o 
- =- o-<-_ =- -—<_ -_ oe - o<-_-_ -— - 
ha ee ee ee ee es es ee se ee ee ee ee ee ee Oe ee ee Oe ed ee es ee ee oe oe es ee ee oe ee oe 2 ee ee 2 2 
~N 
~N 
Es 
. 
o 
2 
.* 
co a oo co [- *] a 
ax < i. 4 az < a 
' i a v ' = 
@ za pa “ a a 
t ' g y t vw 
- ~w <= A= Ww = A= Ww = Aa Ww <= Aa Ww <z<= fi w 
c= « u Oc «cc nu Nec uo We uu Se « ua OO @ wretrttetrsepreevpesvees 
'_mw nm | al | na a 2 Oo Qoereeweesreeesee ee & ss 
. —_— — . —_— — - —_— -— bd —_— — . —_— — — PAPA AAADAAARA AA 
2 22row Zz Zeow Zz Zeow Zz 2erow Zz Z2row ZY EMMMMMMmMmmmmnriny 
=i@gu ww &£ &u VME F&F &ue ME F&F Sue HME EF Su ME) were 
> 3: *#@ OF JD+ *@ OF FA: #W YODA FO: *@ OD ADs WM WODQA astttrseerereeeeeens 
aA IBS WMS UIBGUZ RS UGU3 OH ZUG HOH ST UGPIZ NH JIT HUH HAPRHABAAGAGAGAA 
Or- O08 £0 JOOC0C0O8 £0 UOMOOG LO jOWOOS £9 UOR OO LO VOWS NNN TPUNNn e 
VSNVEE OTe OMVUE ES OTe OMVE OTe OMVUE COT uhOMVE ET OMu Vr wvsr ssw 
32 mo 
Bd aBeBund Dal wdaoduad eu ws Dad a adaad Pu  addiad err woe 
>ar>r>r>ooaemar>a>>raaear>a> > raaer>a> > raawera> > rOa320MMOMS 
OZOOCOME JOTGOOCOVES JOT OOCOVE JOTOOCOVWE JOT OOCOVaA uD Taaes 
Zotz =z - OOZOTEZ ~OOZOZZEZ ~OOZOFSEZ “QAZOZZEZ “D@MAaAgdw - 
a“ A fe a ad poz aA A fA ca af AGA Oe 
oOo ~~ co Cc oS - uN /~ wT w wo ~ ao oc Oo- ~re 
uN N N un Mm ~~ mn ~ Lal nm - Lal mam ws ws 


£OBWOC & — WO EO ST EV OOPMND VEN OWOPMER LOMO Own Owes OowOw dowd 
DODO Ooo < fC OOMDOAOVCVVVVV OOO OWWwwWe whew LOCC RK KKK UOUINIM ST 
LL NII OOO 
SOOCoCCOCOCOSCOCOSOSOOSCOSCSOSOSOSOSOSOSOSOOSCOSOSCOSOSCOOSOSOOSCOOSOOSOOOSCOSOSOSoOSoOSS 
SOOOCCCOOCOCOCOCOCOCOCOCSCOCOCS COCO OOOSoOOCoooooooooQooooooooooo 


O- COCO CO-COOCOOK CO OOCOOK COOK OOOOnKCO- COCO On CO oun ue 
O-—- O00 Kwon Aooeor nr wor acer nr wor Ooo r Kwon An onrmMwat*-@a 


wr ww O <fiawwh WW O & wl WW Ost WW WOOO WwW WWOOC WWW te OMOwww 
WOO INOOtZOOO INOwsT ZOOVWO ZMNOM LT OOVO INO ZOOO INOY tO tO MMe 


04 
08 
04 
08 
04 
08 
04 
08 
04 


000000006 
000000006 
000000006 
000000006 
000000006 


eee See ete ee ee ene 


_BASSMAT_10 Bese 
eT. 1e-8e 


7E 
000000006 00 


so 
oo— 


SSS SRT SSS 
FWOMOONOO 


=———— 

oOow,r 
P ad 
m 


000000006 00 03 


OOOCOoCoCCoooooooooo°oo 


MNWMNOO 


000000006 00 4 


04 =A 
000000006 00 
08 AE 


000000006 00 


VQIOOOOOowVwVwIwOrryr YF SF SF OCOOCOOCBWDOOoO VINO 
BMS VOOM DU ae ded SOS ~wrom 


5 
1 
2 
1 06 =A 
0 
E 
E 


oO wn 
© 
0oo-°0 -9090 -9c 79°90 -9Mm 9 99 - OM "9 OU FO - "09 OOMoOOWW—wov7o-90 | "0 


PO -9ON "OOOO $00" F000 "00-99 "99-99 70 OMOOC0O- "990 —-f—-a » 


PIPOPIPPIPOPINOPYNIPININIPINIPIPINIPININIPUNININIPPPPIPOPINPIPIPYPIPUNIPUNPIPOPIPONIPUNIMIPY 


SOoOoOOOCOSCOVOSOSOSOSOOSOSOOOOOSOOSOOOSOOSOSOOOOOOOCOOOOOOOOoOOoOO 
ee eee ewe foleloiofelelolololel~) 


rmrmmmnao 


NVA 


50 02 


> 


.---—— paeeeneSEEEEEERrcingRERAGORTENNE — — 


= 
5 
bad 


= 
“ 
wn 


= 
~ 
ad 


> 
oo 
Dad 


49$: 


pa198e 3:35:19 Eeaser® 
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SRC JBASMATIO.B32;1 
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° 
= a 
PARPAPAAAAM 


#BASSK DATTYPERR, =-(SP) 
#1, BASSSSTOP 


TEMP_STORE 
48$ 
COLUMN 
ROW 
TEMP_STORE 
51$ 


#2325, NUM DESCRI 
(R9), NUM DESCRIP 
Sci 


w+ 
co 


CRIP+4 


UMN 
NUM_DESCRIP 

#3, BASSFETCH_BFA 
60$ 
COLUMN 
ROW 

NUM DESCRIP 

#4, BASSFETCH_BFA 
60$ 

FLAGS, 54$ 
COLUMN, R1 


COLUMN, R2 
OW, Ri 


BASSFET_FA_G_R8 
FLAGS, 57$ 
OLUMN, R1 


COLUMN, R2 
ROW, RI 

R9, RO 

BASSFET_FA_H RB 

RO, TEMP STORE 

COL URN. OPPER_BOUND1 


ay 
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RO, #21 
at 
RO #246 
‘ LEM_DESCRIP), #21 
DESCRIP, R1 
TEMP. STORE, RI 
RO #14 
TEMP_STORE, -(SP) 
70$ 
RO, #24 
2CELEM DESCRIP). #16 
TEMP_STORE, RI 
NUM_DESCRIP, R1 
(RO), RI 
RO #24 
¢{ELEM_DESCRIP), -(SP) 
2s 
Ps BASSSUDF_wL1 
NUM_ELEMS_DONE 


COL 
COL URN - UPPER_BOUND1 


ROW 

#1, COLUMN 

(RO), #14 

(RO), #24 
(ELEM_DESCRIP), #14 
6$ 


TEMP_ STORE 
#1, STRSFREE1_DXx 
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Data Type Error 


BEGIN 
GLOBAL REGISTER 
CCB = K_CCB_REG : REF BLOCK C, BYTE); 
UILTIN 
ACTUAL COUNT; 
LITERAL 
V_1D FLAG = iP 
K-ONE_OPT_ARG = 2, 
K_TWO_OPT_ARGS = 3, 
K_1D = 1; 


LOCAL 
NUM_ELEMS_DONE, 


LA 
TEMP_STORE : VECTOR [4, LONG), 


. 7 
ASSMAT_10 16-Sep-1986 00:43:4 AX=11 Bliss-32 V4.0-74 P 
tr Versep-i9he 11:88s19 — Foasmre She Sangmitio.os3.1 oer 3 
1206 121 GLOBAL ROUTINE BASSOUT_MAT_B ( ! Matrix pring. no format 
1205 1 § R ' array to print 
1 06 1 SUBSCRIPT1, i first optional subscript 
120 126 SUBSCRIPT2 ! second optional subscript 
: oS ; 5 ) : NOVALUE = 
1210 1 5 lee 
: 1} ; : } FUNCTIONAL DESCRIPTION: 
1 18 130 i The array is printed one element at a time with each element : 
: 8 ; 1 being printed on a separate line. Row and column zero are not printed. 
6 ¢ FORMAL PARAMETERS: 
18 135 i ARRAY.rx.a ' array to print 
19 1 $ : ar said tee Re : first optional subscript 
31 ; . SUBSCRIPT2.rlu.v ! second optional subscript 
3 3 IMPLICIT INPUTS: 
3s 1 NONE 
g § IMPLICIT OUTPUTS: 
3 3 NONE 
0 ; COMPLETION CODES: 
i ; NONE 
34 1 SIDE EFFECTS: 
36 : i Signals: 
4 ! 
a 
8 
9 
0 
4 
5 


RN Re te nt oe Sk el et et ek at 


flag - one dimen. array 
value of arg. count for one 
optional argument 

: value of arg. count for two 
: optional arguments 

one dimension 


total number of array elements processed 


a i a a ed ed eed ed ed 
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wm WNC 0@an 
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SSN NO 


VARA ISSS 


temp storage for calling FETCH_VA 
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“Passmat 10 VeSeoctage Q0se8:43 yates BASMATIO. B39; Paar 5s 


9 
9 
3; 1261 17 ROW, ' current value of subscript 1 
: 126 138 COLUMN ' current value of subseriet 
: 126 180 UPPER_BOUND1, i upper bound for 1 dimensionai 
3 1264 181 ! array and number of rows for 2 
3: 1265 1 ¢ ! dime’ sional orrey 
; 1 68 1 TOTAL _NUM_ITEMS, : total number of items in the array 
; 1 1 5 ELEM_DESCRIP : REF BLOCK (12,BYTE] yoda ins MK. ait, 
3 : ° P ' desc fetched from arra 
: ' 3 ; § NUM_BESCRIP : BLOCK te bytes: ' numeric desc for FETCH 
: 1271 188 P 
: } % ! 9 ARRAY : REF BLOCK C, BYTE]; 
3 r 191 BASS$CB_GET (); 
: 1276 198 i Check to see if this a list of arrays. If it is, then print a blank Line between 
3; 1277 194 ! each array. 
St ti ie 
; ' 80 199 IF .CCB CISBSV_MAT_PRINT) THEN BASSSBLNK LINE (); 
31 8 199 CCB CISBSV_MAT_PRINT) = 1; 
: : th + re FLAGS = 0; 
3 ; 85 5 ; Default TEMP_STORE to a dynamic stirng descriptor 
: 1387 04 2°  TEMP_STORE £0] = %X'020E0000'; 
: : os soe cae TEMP_STORE (1) = %x'00000000'; 
3 : ba 207 Check the number of dimensions and set a flag if only one dimension. 
: 129 09 2. 
; : 38 it IF ARRAY CDSCS$B_DIMCT) EQL K_1D THEN FLAGS = .FLAGS + V_1D_FLAG; 
: 1295 21 '¢ 
3 1296 $1 ! Check for optional arguments. If there are no optional orgunents.. then set 
: 1297 14 : the upper bounds based on what is in the descriptor. If there are optional 
: : | 1g args, then use them as the upper bound. 
31 1 , 
3; 1301 21 IF ACTUALCOUNT () LSS K_ONE_OPT_AR 
3 ! O 219 THEN 1 Sie ah sa 
31 1 IF .ARRAY CDSC$B_DIMCT) EQL K_1D 
: ! 5 ; ; THEN = 
3 :¢ 
: \ $ No optional arguments and a one dimensional array 
: 1309 $ : GIN 
; 1310 UPPER_BOUND1 = .ARRAY (U1 1D); 
; 1 2 OTALNUM_1TEMS = .UPPER_BOUND1; 
18 ELSE an 
: 1315 5 '¢ 
: ! 18 2 dimensional array 
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BASSMAT_I0 16-Sep-1984 00:43:4 AX=-11 Bliss-32 v4.0-74 p 

heir VenSep=198e 11:88:19 — EBasnte Saedeagmatig ess; oor 38 
| UPPER_BOUND! = ARRAY [U2_20]; 

TOTAL-NUM_1TEMS = .ARRAY [U1_20]*.UPPER_BOUND1; 


IF ACTUAL COUNT () GEQ K_ONE_OPT_ARG 

BEGIN 
UPPER_BOUND1 = .SUBSCRIPT1; 
TOTAL-NUM_ITEMS = .SUBSCRIPT1; 
END; 
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IF ACTUALCOUNT () EQL K_TWO_OPT_ARGS 
THEN 


be 
2 optional arguments 


BEGIN 
UPPER_BOUND! = .SUBSCRIPT2; 
TOTALINUM_ ITEMS = .SUBSCRIPT1®, SUBSCRIPT2; 


'¢ 
Initialize the two current subscripts regardless of the number of dimensions 


= ROW = COLUMN = NUM_ELEMS_DONE = 1; 


: Check for array of descriptors. They could be dynamic oer ing descriptors, 
! or numeric descriptors for a dynamically mapped orrer Fetc 

: an element (a descriptor) from the array and check the dtype to 

determine if this is a string array or numeric array. 
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IF _;ARRAY CDSCSB_DTYPE] EOL DSC$K_DTYPE_DSC 
BEGIN 
NUM_DESCRIP CDSCSA POINTER] = TEMP STORE C0); 


IF FLAGS AND V_1D~ 
ELEM_DESCRIP = BASSFETCH_DESC (.ARRAY, 1) 
ELEM_DESCRIP = BASSFETCH_DESC (.ARRAY, 1, 1); 
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Be COSCSK_DTYPE_T) : ' text 
; ) 

CDSCSK_DTYPE_B) : ! byte 

$} J J y 
71 3 BEGIN 
7 UM_DESCRIP pecee CLASS) = DSCSK_CLASS_S; 
7 NUM_DESCRIP [DSCSB_OTYPEJ = DSCSK -DIYPE"B; 
i 91 DESCRIP COSCSW_LENGTH] = ZUPVAL/4; 
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4 ¢ 


TES; 


! out of the array. 
may be virtual. 


CINRANGE ,OUTRANGE) : 
$STOP (BASSK_DATTYPERR); 


BAS 


WHILE .NUM_ELEMS_DONE LEQ .TOTAL_NUM_ITEMS DO 
BEGIN 


CDSCSK_DTYPE_6) : 


IF .FLAGS AND V_1D_FLAG 
TEMP_STORE [0] = BASSFET_FA_B_RB 
TEMP_STORE [0] = BASSFET_FA_B_R8 


CDSCSK_DTYPE_w) : 


IF .FLAGS AND V_1D_FLAG 
TEMP_STORE [0] = BASSFET_FA_W_R8 
TEMP_STORE (0) = BASSFET_FA_W_R8 


[DSCSK_DTYPE_L) : 


IF FLAGS AND V,1D_FLAG 
TEMP_STORE (0) = BASSFET_FA_L_R8 
TEMP_STORE (0) = BASSFET_FA_L_RB 


ELS 


CDSCSK_DTYPE_F) : 


IF .FLAGS AND V_1D_FLAG 
TEMP_STORE (0) = BASSFET_FA_F_R8 
TEMP_STORE [0] = BASSFET_FA_F_R8 


ELS 


eon} 00:45:43 


' Loop thru the array descriptor until all of the elements in the array or as 
; Spec titee by the optional arguments have been printed. 
ne 


CASE. -ARRAY CDSC$B_DTYPE] FROM DSC$K_DTYPE_B TO DSCSK_DTYPE_H OF 


(ARRAY, .COLUMN) 
(.ARRAY, .ROW, .COLUMN); 


(ARRAY, .COLUMN) 
(,ARRAY, .ROW, . COLUMN); 


(ARRAY, .COLUMN) 
(ARRAY, .ROW, .COLUMN); 


(,ARRAY, . COLUMN) 
(.ARRAY, .ROW, .COLUMN); 


AX-11 Bliss-3 
BASRTL.SRCJBA 


Start each row on a 
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MAT 


i Based on the data type. JSB or CALL the proper fetch routine to get the element 
e FETCH and STORE routines are called because the array 
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‘eassqat to ib-sen-19R4 0:45:42 yaNeIT Ling 82 ve 0-742 | 
5 COSCSK_DTYPE_D) : 
if -FLAGS AND V_1D_FLAG 
ae TEMP_STORE [0] = BASSFET_FA_D_R8 (.ARRAY, . COLUMN) 
TEMP_STORE [0] = BASSFET_FA_D_RB® (.ARRAY, .ROW, .COLUMN); 
COSCSK_DTYPE_T) : 
IF .FLAGS AND V_1D_FLAG 
BASSFETCH_BFA (.ARRAY, TEMP_STORE [0], .COLUMN) 
BASSFETCH_BFA (. ARRAY, TEMP_STORE CO], .ROW, .COLUMN); 
COSCSK_DTYPE_DSC) : 


S&S SE 


LESRALLSSSLESEANLES 


BEGIN 
ined | ataaeaiel COSCSB_DTYPE] FROM DSCS$K_DTYPE_8 TO DSCSK_DTYPE_H OF 


CDSCSK_DTYPE_B, DSC 
DSCSK“DTYPE-D. DSC 
BEGIN 


3 


$k. 
$k7 


WAAR POPPY PONIPYNPINYNY 2 OO es es ss oe ee 


TEMP_STORE (0) = %x‘00000000'; 
IF .FLAGS AND V_1D_FLAG 


THEN ASSFETCH_BFA (, ARRAY, NUM_DESCRIP, .COLUMN) 
a0 BASSFETCH_BFA (.ARRAY, NUM_DESCRIP, .ROW, .COLUMN); 
END; 
CDSC$K_DTYPE_T) : 
IF FLAGS AND V_1D_FLAG 
BASSFETCH_BFA (.ARRAY, TEMP_STORE (0), . COLUMN) 
BASSFETCH_BFA (.ARRAY, TEMP_STORE (0), .ROW, .COLUMN); 


CINRANGE OUTRANGE) : 
BASS$STOP (BASSK_DATTYPERR); 
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TES; 
END; ' end of dtype dsc 
CDSCSK_DTYPE_PJ : 


i Must pass a descriptor to BAS$SUDF_WL1. Construct 
descriptor here, and set the pointer field to TEMP_ 
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BEGIN 
NUM_DESCRIP CDSC$B_CLASS] = DSCSK_CLASS_SD; 
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1 
YP 
vin. 
ALE) 
INTE 


SC$K_DTYPE_P; 
: 1 rh rhe ¢ NUR-DESCRI iat ; PARA cps arated 
NUM“DESCRIP [DSCSB- :. ALE); 
: i rk is 4 NUM~DESCRIP betsaceo R} = TEMP_STORE [0]; 
; 1 ¢ ¢ IF FLAGS AND V_1D_FLAG 
; i ¢ ¢ NBASSFETCH_BFA (. ARRAY, NUM_DESCRIP, . COLUMN) 
; 1 cr ¢ BASSFETCH_BFA (.ARRAY, NUM_DESCRIP, .ROW, .COLUMN); 
: 1 £38 ; 
$1 474 
: 1385 cre CDSCSK_DTYPE_G) : 
 1eey cr IF .FLAGS AND V_1D_FLAG 
; i 8 180 “ NTEMP_STORE [0] = BASSFET_FA_G_R8 (.ARRAY, .COLUMN) 
; i re i us TEMP_STORE [0] = BASSFET_FA_G_R8 (.ARRAY, .ROW, .COLUMN); 
; 1369 ¢ CDSCS$K_DTYPE_H) : | 
; 1568 ¢ 3 IF .FLAGS AND V_1D_FLAG 
i} 79 is} TEMP_STORE [0] = BASSFET_FA_H_R8 (.ARRAY, . COLUMN) 
3; 1571 488 - = . 
: 1278 490 TEMP_STORE [0] = BASSFET_FA_H_RB (.ARRAY, .ROW, .COLUMN); 
+ 1574 491 6 
tah 43 meer tt OL om ttt DATTYPERR); 
1335 494 TES; . 
1379 498 BASSSUDF_wWL1 ( | 
1579 496 
: 13ar ie a SCRIP CDSC$B_DTYPE] ELSE .ARRAY CDSCS 
: 1882 199 4 IF (ARRAY CDSC$B_DTYPE] EQL DSCS$K_DTYPE_DSC) THEN .ELEM_DE ¥ 
; 1385 500 4 
: 1584 501 4 END : 
: 13Be 208 i * BEGIN 
; 158% 208 4 TEMP_STORE : BLOCK (8,BYTE); 
; 1390 268 $ (IF .ARRAY CDSC$B_DTYPE) EQL DSC$K_DTYPE_T 
a BB ee STON CSch, NG 
; 1398 319 6 (IF .ARRAY CDSCSB_DTYPE) EQL DSC$K_DTYPE_DSC 
; 1398 218 3 IF .ELEM_DESCRIP CDSC$B_DTYPE) EQL DSCS$K_DTYPE_T 
; 1399 18 3 “ " TEMP_STORE COSC$W_LENGTH) 
1800 319 6 as .NUM_DESCRIP COSC$W_LENGTH) 
: $1 ELS 
: 1802 319 § ARRAY CDSC$W_LENGTH])) 
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'¢ 
| eure any temporary storage used and then return 


IF ARRAY v poses. DTYPE] EQL DSC$K_DTYPE_T OR 
DSC$B-DTYPE) EQL DSK" DTYPE “DSC AND 
: i ten _DESCRIP"CDSC$B_DTYPE) EQL DSC$R_DTYPE_T) 
STRSFREE1_DX (TEMP_STORE); 
RETURN; 
END; ‘End of BASSOUT_MAT_B 
OFFC 00000 ENTRY BASSOUT MAT_B, Save R2,R3,R4,R5,R6,R7,.R8,~ ; 2121 
SE 30 C2 002 SUBL2 & SP ; 
000000006 00 16 0000 JSB BASSS(B GET ; 3191 
7 97 AB : E1 0000 BBC , “105(CCB), 1$ + 2197 
000000006 00 cB 001 CALLS #0, BASSSBLNK_LINE ; 
97 AB 4 88 00017 1$ BISB2 #4. -105(CCB) + 2199 
08 AE D4 0018 CLRL Acs : 2200 
20 AE 020E00 BF DO OOOTE MOVL § #34471936, TEMP_STORE > 2204 
4 AE 04 0026 CLRL ‘TEMP _STORE+4 > 2205 
59 4 AC 00 000 MOVL ARRAY, R9 > 2210 


e, 
16-Sep-1984 00:43:4 AX-11 Bliss-32 V4.0-74 Pa 43 
1o-ge8=} 382 90:98:45 BASRTL.SRC JBASMATIO.B $3.1 ad (9) 
END ; 
CF ARRAY CDSCS$B_DTYPE] EQL DSC$K_DTYPE_P 
isi" DESCRIP ' pass dsc for packed 
(IF oARnAy COSCSB_DTYPE] E thee bryee DSC AND 
rmeweee™ _DESCRIP~COSC$B_D TYPE EQC DSCSR_DTYPE_P 
NUM_DESCRIP 
ELS 


TEMP_STORE)), 


um Tine -NO_FORM) ; 
ELEMS PONE = Mun -ELEMS_DONE + 1; 
COLOMN = > COLUMN 


IF .COLUMN GTR omen. penet 
THEN 
BEGIN 


It is time to start a new row. 


ROW = .ROW + 1; 
COLUMN = 1; 
END; 


END; ' end of the WHILE loop 
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ib-se -1984 00:43:4 AX-11 Bliss-32 v4.0-74 Page 47 
12-88-1984 00:98:48 EBASRTL SRe BASMATIO. 8391 9 9) 
44$-43$,- ; 
44$-43$,- : 
45$-43$,- : 
44$-43$.- : 
44$-43$,- : 
44$-43$.- : 
44$-43$.- : 
44$-43$.- : 
45$-43$.- : 
7E 006 BF 9A 00252 648: ROVZBL SBASSK DATTVPERR, (SP) : 2450 
000000006 00 01 FB 09 56 CALL #1, BASSS$STOP : 
48 11 00250 BRB 52§ : 
20 AE D4 0025F 458 CLRL TEMP_STORE + 243 
1E 11 00262 BRB 48$ + 243 
5A 0D 00 64 46$:  PUSHL COLUMN + 26a7 
08 AE DD 00266 PUSHL ROW : 
28 AE 9F 00269 PUSHAB TEMP_STORE : 
30 11 0026C BRB : 
1A AE 0915 BF BO 0026E 47$: MOVW #2325, NUM DESCRIP+2 + 2463 
18 AE 69 B80 00274 MOVW (R9), NUM_BESCRIP + 2464 
20 AE 08 A9 90 00278 MOVB 8 (R95, NUM_DESCRIP+8 > 2665 
1¢ AE 20 AE 43 0027D MOVAB TEMP_STORE, NUM_DESCRIP+4 + 2466 
10 08 AE €9 00282 48$: BLBC FLAGS, 50$ + 2468 
SA DD 00286 PUSHL COLUMN + 2470 
1¢ «AE OOF 0028 PUSHAB NUM_DESCRIP : 
59 DD 00288 49$ PUSHL F 
000000006 00 03 FB 0028 CALLS #3, BASSFETCH_BFA : 
4B 11 00294 BRB 60$ : 
SA DD 00296 S0$: | PUSHL COLUMN + 2472 
08 AE DD 00298 PUSHL ROW : 
20 AE 9F 00298 PUSHAB NUM_DESCRIP : 
59 DD 0029 51$ PUSHL R9 ; 
000000006 00 04 FB 002A0 CALLS #4, BASSFETCH_BFA : 
38 11 O02A7 528: BRB 60$ : 2371 
05 08 AE €9 002A9 53$:  BLBC FLAGS, 54$ : 2478 
51 SA DO O02AD MOVL COLUMN, R1 + 2480 
07 11 00280 BRB 55$ ; 
52 5A 00 00382 54$: MOVL COLUMN, R2 + 2482 
51 04 AE DO 0028 MOVL ROW, RI ; 
50 59 D0 00289 55$ MOVL R : 
000000006 00 16 00 8 JSB BASSFET_FA_G_R8 ; 
19 11 002C BRA 3 
05 08 AE €9 0 C4 56$: BLBC FLAGS, 57$ + 2486 
51 5A 00 002¢8 MOVL COLUMN, R1 : 2488 
07 11 002¢B BRB 58$ ; 
52 A DO 002CD 57$:  MOVL COLUMN, R2 : 2490 
51 04 AE DO 00200 MOVL ROW, RI : 
50 59 00 00204 58$ MOVL R F 
000000006 00 16 00207 JSB BASSFET FA_H_R8 ; 
20 AE 30 DO 002DD 59$:  MOVL RO, TEMP_STORE : 
03 DD O02E1 60$:  PUSHL # : 3496 
50 02 Ad 9A 002E3 MOVZBL 2(R9), RO > 2522 
15 50 91 002E7 CMPB RO, «#01 ; 
oF 13 OO2EA BEQL ; 
18 0 91 002EC CMPB R) #24 > 2526 
10 12 OO2EF BNEQ 626 ; 
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OE 5 91 9 
06 12 QA 
7E 28 af 3¢ OC 
g 11 00310 
18 0 91 3 ig 
48 \¢ 1 
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ae: 8 8 Ee 
1 8 HH Be 
51 69 3C 0390 
51 DD 00350 
18 50 91 EET: 
OA 12 003 
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Q2 11 0033 
50 0D it ee 
000000006 00 10 o 4 3 re 
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Oc AE 5A 01 0034F 
06 15 Bo Ree 
04 AE 06 00355 
5A 01 0358 
FDEB 31 O38 
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20 AE OF 00373 
000000006 00 0 fe 4 16 
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64$: 


73$: 
74%: 


1986 99:55: 
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#2, ELEM_DESCRIP, R1 
(RI), #27 


2$ 
NUM_DESCRIP, R1 
§ 
TEMP STORE. R1 
RO, #14 
TEMP_STORE. -(SP) 
68$ 
RO, #24 
#2, ELEM_DESCRIP, R1 
(RID, #iz 


6 
TEMP_STORE, R1 
NUM_DESCRIP, R1 
7$ 
(RO), RI 
R1 
RO #24 
#2, ELEM_DESCRIP, R1 
(Ri), -(SP) 
70$ 


RO 
#4, BASSSUDF WL 
NUM_ELEMS_DONE 


COL 
50 UN. UPPER_BOUND1 


ROW 
“i, COLUMN 
(RO), #14 
g(R9), #24 
#2, ELEM_DESCRIP, RO 
(RO), wit 


4 
TEMP_STORE 
#1, STRSFREE1_DXx 
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1e-Sep=1986 11:55:19 Eeasmtu sme Seasmatio.@39; 1 


¢ 1 GLOBAL ROUTINE BASSIN_MAT ( ! Matrix input 

27 : 5 le ‘ ! array to print 

65 1 . 

68 1 tee 

of : FUNCTIONAL DESCRIPTION: 

34 1: The array is input one element at a time by rows. Input may be con- 
570 1! tinued on the next Line by an ‘8’. Only those elements for which new 
@) : } data is entered are changed. 

Hf : FORMAL PARAMETERS: 

if ' ! ARRAY .wx.a The array to put the data into 

$7 1 | IMPLICIT INPUTS: 

578 1! 

579 1! NONE 

580 1! 

a3! : IMPLICIT OUTPUTS: 

288 1 i number of rows or elements entered 

eee : } NUM2 eye cumnee oF crapents entered in the last row 

‘ wo dimensiona 

5 1! 

3B 1 ! COMPLETION CODES: 

588 1! 

589 1! NONE 

590 1! 

591 1! SIDE EFFECTS: 

4 8 

593 1! Signals: 

594 1! Invalid data type 

4 ; 

299 - 

598 BEGIN 

599 

600 GLOBAL REGISTER 

ret CCB = K_CCB_REG : REF BLOCK C, BYTE); 

60 LITERAL 

604 V_ID_FLAG = 1, ! flag = one dimen. array 

606 K_1D = 1; ! one dimension 

60 LOCAL 

ons nn ELEMS_DONE, ! total number of array elements processed 

610 TEMP_STORE : VECTOR [4, LONG), ! temp storage for calling FETCH_VA 

611 ROW, ' current value of subscript 1 

olg COLUMN : current value of subscript 2 

61 UPPER_BOUND1, i upper bound for 1 dimensional 

oi array nd quater of rows for 2 
' dimensional arra 

$16 TOTAL _NUM_ITEMS, : sates paumer of Teens in the array 
' excluding row and col. 

618 ELEM_DESCRIP : REF BLOCK (12,BYTE), ! desc fetched from array 
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NUM_DESCRIP : BLOCK (8,8YTE]; ! temp numeric desc for STORE 


— 
aw 
Vw 


Pp 
ARRAY : REF BLOCK C, BYTE]; 
BASSSCBGET (; 
- FLAGS = 0; 
Default TEMP_STORE to a dynamic stirng descriptor 


TeeRUQE ERY = HEBREENRS 


i Check number of dimensions and initialize the number of elements in the array. 
: Set a flag if only one dimension. 


IF .ARRAY COSCS$B_DIMCT) EQL K_1D 
THEN 
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Www 


5 «FLAGS + V_1D_FLAG; 
UPPER_BOUND1 = .ARRAY“CU1 1D); 
TOTAL_NUM_ITEMS = .UPPER_BOUND1; 


BEGIN 
UPPER_BOUND1 = .ARRAY (U2_2D); 
TOTAL -NUM_ ITEMS = ,ARRAY [U1_2D)]*.UPPER_BOUND1; 
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rs 


te 
Initialize the two current subscripts regardless of the number of dimensions 
ROW = COLUMN = NUM_ELEMS_DONE = 1; 


“ 
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'¢ 

: If this is an array of descriptors, they may be dynamic string descriptors or 
: numeric descriptors in the case of a dynamically Sepped array. Check the 

: first element descriptor to determine the dtype (all elements of the array 
should be the same). 


ey ey SS 
PAA 


ees COSCS$B_DTYPE) EQL DSCS$K_DTYPE_DSC 


WN —O OONOAUS wn 


SO OS- 


GIN 
IF FLAGS AND V_1D_FLAG 
ELEM_DESCRIP = BASSFETCH_DESC (.ARRAY, 1) 
ELEM_DESCRIP = BASSFETCH_DESC (.ARRAY, 1, 1); 
CASE. -ELEM_DESCRIP CDSC$B_DTYPE] FROM DSC$K_DTYPE_B TO DSCSK_DTYPE_H OF 


23235; 
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(DSCS$K_DTYPE_B) : 
NUM_DESCRIP CDSC$B_CLASS) = DSC$K_CLASS_S; 
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| BASSMAT_I10 ibese =1984 00:43:4 AX-11 Bliss-32 V4.0-74 
1-016 12-8 08- 198 90:88:46 BASRTL.SRCJBASMATIO.B $3.1 
17 733 aaa vt | OUTRANGE) 
18 u 4 $sToP (Sassi _DATTYPERR) ; 
f § TES; 
¢ 4 3 NUM_DESCRIP CDSCSA_POINTER] = TEMP_STORE (0); 
3 ey END; ! dtype dsc 
: 74 IF .ARRAY COSCSB_DTYPE] EQL DSCSK_DTYPE_P 
74 THEN 
: 744 BEGIN 
745 NUM_DESCRIP pecee CLASS) = DSCSK_CLASS_SD; 
830 bg | NUM_DESCRIP CDSCSB_DTYPE) = DSCSK_DTYPE P; 
831 NUM_DESCRIP CDOSCSW_LENGTH] = .ARRAY COSCSW_LENGTH); 
8 § 748 NUM_DESCRIP [DSCS$B_SCALE] = .ARRAY CDSC$B SSALE J: 
;  eaaettaal DSCSA_POINTER] = TEMP_STORE [0]; 
B35 ‘. ; 
8 i Loop thru the array descriptor until all of the elements in the array or as 


_many as are supplied are input. 


WHILE, (NUM ELEMS. DONE LEQ .TOTAL_NUM_ITEMS) AND 
(IF .ARRAY CDSC$B_DTYPE) 2 Eat DSCSK_DTYPE_DSC THEN .ELEM_DESCRIP CDSC$B_DTYPE) 
ELSE RARRAY CDSCSB_DTY Ped) 
(IF (ARRAY COSC$B_OTYPE) EGL DSC$K TYPE. T) 


.TEMP_STORE (0) 
CIE ARRAY CDSCSB_DTYPE] EOL DSCSK_DTYPE_DSC 


Ww 


ee ee eee ee eee ee ee ee ee ee ee ee ee ee ee ee ee ee ee ee ee ee ee ee ee ee ee ee ee ee ee ee ee ee ee ee ee 
‘Gd Gd Cd Cd Cd Od OS Od OD Cd OO CD 0000 
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766 
444 if gELER_DESCRiP COSCS$B_DTYPE] EQL DSCSK_DTYPE_T 
769 .TEMP_STORE (0) 
770 ELS 
aa 1. -NUM_DESCRIP COSC$W_LENGTH) 
77 ARRAY 5c$B,DTVPE L gig ! 
774 (IF .ARRAY Epsc TYPE] EQL DSCS$K_DTYPE_P OR 
775 (CARRAY (CDSC$B YPE EQL DSC$K~ OTYPES DSC AND 
360 aA eget EM DESCRIP” pscsa -DTYPE] EQC DSCSR_DTYPE_P) 
86 778 NUM_DESCRIP ! pass desc for packed 
Be 779 
864 780 TEMP_STORE), ! 
865 781 BAS$K_NUCL)) DO 
+4) , § - GIN 
He 784 ' Based on the data type, JSB or CALL the proper store routine to put the element 
869 785 i into the erray. The FETCH and STORE routines are called because the array 
70 7 i may be virtua 
71 7 ie 
7 3 
7 7 IF .COLUMN GTR .UPPER_BOUND1 
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H 8 
_BAssmaT 10 -Sep-1 14334 AX-11 Bliss-32 V4.0-7%4 P 3 
on Het 1 99:38:96 BASRTL.SR ReSBASMATio. oso; 29° 493 
3; 1876 ; THEN 

: 1875 BEGIN 

> 187 f i} 4 t+ 

; 187 795 4 ! It is time to start a new row. 

3; 187 794 & Ie 

> 187 795 4 ROW = .ROW + 1; 

> 1 ? COLUMN’ = 1; 

. : = 

; 1 ; 199 CASE -ARRAY CDSCSB_DTYPE] FROM DSCSK_DTYPE_B TO DSCSK_DTYPE_H OF 

; 1885 601 

i] O¢ CDSCSK_DTYPE_B) : 

; ' 04 JF FLAGS AND V.1D_FLAG 

; 1890 06 cy geOASSSTOAFAAB_RS (.TEMP_STORE C03, ARRAY, .COLUMND 

: 1892 08 BASSSTO_FA_B_R8& (.TEMP_STORE [0], .ARRAY, .ROW, .COLUMN); 
; 189% 10 CDSCSK_DTYPE_w) : 

> 1895 11 

i 1896 I IF .FLAGS AND V_1D_FLAG 

3; 189 1 THEN 

3 Hh 4 HF me BASSSTO_FA_W_R& (.TEMP_STORE (OJ, .ARRAY, .COLUMN) 

; 1900 ae BASSSTO_FA_W_R8 (.TEMP_STORE [0], .ARRAY, .ROW, .COLUMN); 
; 1908 eis CDSCS$K_DTYPE_L) : 

; 190 1 

¢ 190% $37 IF .FLAGS AND V_1D_FLAG 

3 1906 822 BASSSTO_FA_L_R& (.TEMP_STORE CO], .ARRAY, .COLUMN) 

3 190 8 ELSE 

3 H's ase BASSSTO_FA_L_R& (.TEMP_STORE [0], .ARRAY, .ROW, .COLUMN); 
; 1910 H 6 CDSCSK_DTYPE_F) : 

; 1918 : : IF .FLAGS AND V_1D_FLAG 

; 1914 9 cr seBASSSTOAFAAF_RS (.TEMP_STORE C03, ARRAY, . COLUMN) 

; 1916 3 BASSSTO_FA_F_R8 (.TEMP_STORE [0], .ARRAY, .ROW, .COLUMN); 
; 1918 CDSCSK_DTYPE_D) : 

3 191 5 

; 1920 IF FLAGS AND V,1D_FLAG 

; 19 § 38 BASSSTO_FA_D_R& (.TEMP_STORE (OJ, .TEMP_STORE (1), .ARRAY, 
1954 0 — 

; 1925 1 BASSSTO_FA_D_RB (.TEMP_STORE (OJ, .TEMP_STORE [1], .ARRAY, .ROW, .COLUMN); 
; 19 ; § (DSCSK_DTYPE_T) : 

: 19 $ 45 IF .FLAGS AND V_1D_FLAG 

: 19 6 THEN 
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; 19 1 7 _ seOASSSTORE BFA (TEMP_STORE [0], .ARRAY, .COLUMN) 

; 19 : BASSSTORE_BFA (TEMP_STORE [0], .ARRAY, .ROW, .COLUMN); 

3 1935 CDSCSK_DTYPE_DSC) : 

: 19 § BEGIN 

; 9 : 4 CASE = ELEM_DESCRIP COSCSB_DTYPE] FROM DSC$K_DTYPE_B TO DSCS$K_DTYPE_H OF 
; 1940 ri 

: 1941 5 4 CDSCSK_DTYPE_B, DSCSK_DTYPE_W, DSCSK_DTYPE_L, DSCSK_DTYPE_F 

; 196 $ 4 DSCSK-DTYPE-D, DSCSK-DTYPE-G, DSCSK-DTYPE-H, DSCSK-DTYPE_P4 

3 1944 B60 4 IF_.FLAGS AND V_1D_FLAG 

3 1945 1 4 

; 1946 864 4 BASSSTORE_BFA (NUM_DESCRIP, .ARRAY, .COLUMN) 

; 1948 B64 4 BASSSTORE_BFA (NUM_DESCRIP, .ARRAY, .ROW, .COLUMN); 

; 1950 ri (OSCSK_DTYPE_T) : 

3; 1951 867 4 

3 1958 868 4 IF .FLAGS AND V_1D_FLAG 

3; 195 869 4 THEN 

3 He) 370 ? BASSSTORE_BFA (TEMP_STORE [0], .ARRAY, .COLUMN) 

; 1328 13 ? BASSSTORE_BFA (TEMP_STORE [0], .ARRAY, .ROW, .COLUMN); 
; 1958 874 4 CINRANGE ,OUTRANGE) : 

> 1959 875 4 
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BASSSSTOP (BASSK_DATTYPERR); 
TES; 


Eze 


St oS 8 


3 3 4 

.? 4 

3 : 4 

; } END; ' data type dsc 

; ' CDSCSK_DTYPE_P : 

31 IF .FLAGS AND V_1D_FLAG 

3; 1970 THEN 

; 1971 EL see MS SSTOREABFA (NUM_DESCRIP, ARRAY, .COLUMN) 

; 1378 ab BASSSTORE_BFA (NUM_DESCRIP, .ARRAY, .ROW, .COLUMN); 

: 1975 90 CDSCSK_DTYPE_G) : 

; 1976 91 

; Hb L i IF .FLAGS AND V_1D_FLAG 

; 1978 a9 a BASSSTO_FA_G_R8 (.TEMP_STORE (0), .TEMP_STORE [1], .ARRAY, .COLUMN) 
; 1981 89 BASS$STO_FA_G_R8 (.TEMP_STORE [0], .TEMP_STORE [1], .ARRAY, .ROW, .COLUMN); 
; 1988 898 CDSCS$K_DTYPE_H) : 

3 1984 899 

; 1985 900 If .FLAGS AND V_1D_FLAG 

; 198 90 BASSSTO_FA_H_R8 (.TEMP_STORE £0, . TEMP_STORE ft. 

3 1988 90 -TEMP“STORE [2], .TEMPTSTORE [3], .ARRAY, .COLUMN) 
3 1989 904 ELSE 

3 1990 905 BASS$STO_FA_H_R8 (.TEMP_STORE £0}, . TEMP_STORE C11, 

; Had 208 . TEMPSTORE , »TEMP-STORE (3), .ARRAY, .ROW, .COLUMN); 
; 1998 908 CINRANGE, OUTRANGE) : 

> 199% 909 BASSSSTOP (BAS$K_DATTYPERR); 

3 1995 910 TES; 

; 1996 911 

3 199 9¢ NUM_ELEMS_DONE = .NUM_ELEMS_DONE + 1; 

3 1998 91 COLOMN = [COLUMN + 1; 

3 hos 4 END; ! end of the WHILE loop 

; 901 916 NUM = (IF .FLAGS AND V_1D_FLAG THEN .COLUMN = 1 ELSE .ROW); 

; § 4, ca NUM2 = (IF .FLAGS AND 0_1B_FLAG THEN O ELSE .COLUMN - 1); 

; 004 319 Return any temporary storage used and then return 

; 921 2 

; $09 9 ¢ IF ARRAY [DSC$B_DTYPE] EQL DSC$K_DTYPE_T OR 

; 2008 9 (ARRAY DSC$B-DTYPE EQL DSC 8K DTYPE-DSC AND 

; 008 3 $ -ELEM_DESCRIP”CDSC$B_DTYPE) EQC DSC$R_DTYPE_T) 

; th 926 STRSFREE1_DX (TEMP_STORE); 

: O18 3 RETURN 

3 2014 9 5 END; ‘End of BASSIN_MAT 
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OFFC 00000 ENTRY BA ‘scan Save R2,R3,R4,R5,RO,R7,RBRI,- ; 2562 
SUBL2 : 
" 000000006 36 ig 0008 158 St GET ; 6 4 
24 «AE 020E0090 7 DO 090 MOVL wei 1936 TEMP_STORE + 2629 
AE D4 a1 CLRL ‘TEMP _STORE+4 ¢ 2630 
59 4 A 0 001 MOVL He 3: 26 
01 A 001 CPB 11¢R95, #" ; 
BAER | Eat Seth, wees pone : $a 
2 Ar 6 AE 09 00 9 MOVL PPER_BOUND1,~ TOTAL_NUM_1I TEMS ; eis 
: (R9), UPPER + 264 
we BB BRB Bh, Bam arias! omnis | Se 
ee A) a a i 1 ee 
$e AE 2 RG BP ire} mOVA BRON 12(SP) + 2661. 
1 Oe 31 00040 CMPB a 2(SP), #24 j | 
oot PEL ae 
9 00056 3$: BLBC FLAGS, 4$ + 2664 
otis fet o i a 
000000006 00 02 FB 004D CALLS #2. BASSFETCH_DESC ; | 
i a Ee 
00000006 90 03 FB Dooee CALLS #3, BASSFETCH. DESC ae 
0 : ; 
: RO, ELEM DESCRIP ; 
16 Sh 02 Hy BP 80078 " CASES (ELEM DESCRIP), #6, #22 : 2670. 
002€ 004F 004 003 0078 6$: <WORD 8$-6$,> ; 
: 7 $-6$.- 
a a a ie : 
0068 002€ 002€ a8 0009 7$-6$,- : 
O0ZE Q02E 00 118-68, - ; 
wee itt ied 002€ BOOAS 135-68, ; 
7$-6$.- ; 
(S5ca8,- ; 
7$-6$,- 3 
7$-6$,- 3 
7$-6$.- : 
7$-6$,- ; 
7$-6$,- 3 
7$-6$,- 3 
14$-6$,- ; 
7$-6$,- 3 
5 at 3 
7$-6$,- : 
7$-6$.- : 
7$-6$.- : 
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| BASSMAT_IO A ae 1984 74 Ak-11 Bliss<-32 V4.0-74 Pa 
11 at 16 1a-Sep- 138 9: $8: $ BASRTL.SRCJBAS §MAT 10.8 533.1 ge 90 
77 11 QO2CS 55§: BRB. 8S ; 
04 AE DD 002C7 568: PUSHL COLUMN : 2872 
OC AE DD OO2CA PUSHL ROW : 
5 bb 02CD PUSHL R : 
30 AE OF OO2CF PUSHAB TEMP_STORE : 
1F 11 0 D2 BRB 1$ : 
11 6E £9 002d. 578 BLBC =~ FLAGS, 60$ 3 2884 
04 AE DD 00207 PUSHL COLUMN 3 2886 
24 Z Br 5 be PUSHAB ' _DESCRIP : 
000000006 00 : FB O20F 385: CALLS #3, BASSSTORE_BFA : 
6 11 00 EG 9$: BRB 6a$ : 
04 AE DD 00268 60S: PUSHL COLUMN : 2888 
OC AE 0D 002EB PUSHL ROW : 
59 DD O02E PUSHL R9 : 
28 «AE OF O02F PUSHAB NUM_DESCRIP : 
000000006 00 04 FB OO2F3 61$ CALLS #4, BASSSTORE_BFA F 
42 11 OOOFA BRB 6 + 2884 
06 6— €9 OO2FC 62$:  BLBC FLAGS, 63$ + 2892 
5 04 AE DO OOF MOVL COLUMN, R3 : 28 
08 11 00303 BRB 64$ : 
54 04 AE DO 00305 63S: MOVL COLUMN, R4 : 28% 
53 08 AE DO 00309 MOVL ROW, RS : 
52 59 DO 0030D 648 MOVL R9, R : 
50 24 AE 7D 00310 MOVG TEMP STORE, RO : 
000000006 00 16 00314 JSB BASSSTO_FA_G_R8 : 
22 11 OO31A BRB 68$ + 2892 
06 6E €E9 0031C 65$: BLBC FLAGS, 66$ + 2900 
55 04 AE DO 0031F MOVL COLUMN, RS : 2902 
08 11 00323 BRB 67$ : 
56 04 AE DO 00325 66$:  MOVL COLUMN, R6 : 2905 
55 08 AE DO 003 9 MOVL ROW, R5 ; 
54 59 DO 0032D 67$: MOVL 9, R4 ; 
52 2¢ AE 7D 00330 MOVO TEM MP_STORE+8, R2 : 
50 24 AE 7D 00334 MOVQ TEMPTSTORE, R : 
000000006 00 16 00338 JSB BASSSTO FA_H RB : 
18 AE 06 ates 68$ INCL NUM_ELEMS BORE ; 2313 
046 =#A b6 00341 INCL LOMN : 291 
FDE 1 00344 BRW 20$ : 2757 
07 6— £9 00347 69$:  BLBC. FLAGS, 70$ : 2916 
52 06 «aE 01 €3 0034A SUBL3 #1, COLUMN, R2 F 
04 11 0034F BRB at} ; 
52 08 AE DO 00351 708: MOVL ROW, R2 ; 
00000000' Ff 5 D9 99 35 71$:  MOVL  R2, NUM : 
6E CE C BLBC F AGS, 72$ : 2917 
52 D4 0035F CLRL ; 
05 11 00361 BRB : $ ; 
52 04 AE 1 C3 0363 738: SUBL3. #1, COLUMN, R2 ; 
00000000" EF 2 00 00368 73$:  MOVL R2. NUM ; 
O€ Oc BE 91 0 6f CMPB Os a O(SP), #14 : 2922 
Cc 13 3 BEQL 4 3 
rT} 0c BE 91 0037 CMPB sa 12 (SP), #24 > 2923 
10 12 00379 BNEQ ; 
OE 02 AA 91 9 78 CMPB ssh DESCRIP), #14 + 2924 
OA 12 0037F BNEQ 5 ; 
24 AE OF 00 81 74$: PUSHAB TEMP STORE > 2926 
000000006 00 01 FB 00 CALLS , STRSFREE1_DX ; 
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un Time 

; opts Hee: 
; Lines/CPU Min: g328. 

egy Ak ade 24399 

nenory Used: 367 pages 
ation Complete 


3608 code, + 8 data bytes 


“BASSMAT_IO bese sep-19 43:4 AX-11 Bliss-32 V4.0-74 Page 61 
AM 12-08-1984 90:98595 BASRTL.SRC BASMATi9.o3351 ° a) 
| 04 00588 75$: RET : 2929 
3 Routine Size: 908 bytes, Routine Base: _BASSCODE + OABA 
, 015 330 1 
‘f O16 931 END 'End of module = BASSMAT_IO 
018 98 0 ELUDOM 

; PSECT SUMMARY 

: Name Bytes Attributes 

> _BASSDATA 8 NOVEC, WRT, RD .NOEXE,NOSHR, LCL, REL, CON, PIC,ALIGN(2) 

; “BASSCODE 3606 NOVEC, *NOWRT, RD, EXE, SHR, LCL, REL, CON, PIC,ALIGN(2) 

3 Library Statistics 

; swocenen= Symbols -<------ Pages Processing 

3 File Total idaded Percent Mapped Time 

: _$255$DUA28:(SYSLIBISTARLET.L32;1 9776 18 0 581 00:01.2 

; COMMAND QUALIFIERS 

; BLISS/CHECK=(FIELD, INITIAL OPTIMIZE) /NOTRACE/LIS=LIS$:BASMATIO/OBJ=0BJ$:BASMATIO MSRC$:BASMAT IO/UPDATE=(ENHS$:BASMATIO) 
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